!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_constants.f90,v $:
! $Revision: 1.3 $
! $Author: jorissen $
! $Date: 2010/12/16 18:30:30 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!*************************************************************************
      module constants

      implicit none

      ! Symbolic names for kind types of 4-, 2-, and 1-byte integers:
      integer, parameter :: I4 = selected_int_kind(9)
      integer, parameter :: I2 = selected_int_kind(4)
      integer, parameter :: I1 = selected_int_kind(2)
      ! Symbolic names for kind types of single- and double-precision reals:
      integer, parameter :: SP  = kind(1.0)
      integer, parameter :: DP  = kind(1.0D0)
      ! Symbolic names for kind types of single- and double-precision complex:
      integer, parameter :: SZ  = kind((1.0,1.0))
      integer, parameter :: DZ  = kind((1.0D0,1.0D0))
      ! Symbolic name for kind type of default logical:
      integer, parameter :: LGT = kind(.true.)
      private i1,i2,i4,sp,dp,sz,dz,lgt

      real(dp), parameter :: pi2 = 6.283185307179586476925286766559_dp
      real(dp), parameter :: pi  = 3.1415926535897932384626433832795_dp
      real(dp), parameter :: one = 1.0_dp
      real(dp), parameter :: zero  = 0.0_dp
      real(dp), parameter :: third = 1.0_dp/3.0_dp
      real(dp), parameter :: raddeg = 180.0_dp/pi
!     kf = fa/rs with fa = (9*pi/4)**third, see Ash&Merm, pg 37
      real(dp), parameter :: fa = 1.919158292677512811_dp
      complex(dz), parameter :: coni = (0.0_dp,1.0_dp)
      real(dp), parameter :: bohr = 0.529177249_dp
      real(dp), parameter :: ryd  = 13.605698_dp
      real(dp), parameter :: hart = 2.0_dp*ryd
      real(dp), parameter :: alpinv = 137.03598956_dp
      real(dp), parameter :: alphfs = 1.0_dp/alpinv

      ! from moduleseels.f 
      ! conversion from eV to Ry :
      real(dp), parameter :: ev2Ry = 1.0_dp/13.6058_dp
      !  h/2pi c in units eV a.u.
      real(dp), parameter :: hbarc_eV = 1973.2708_dp/0.529177_dp
	  real(dp), parameter :: hbarc_atomic = 137.04188_dp  ! i.e. in Ha, hence 27.2 times smaller than above
      ! electron rest mass times c^2 in au (ie, 1 * alfa * alfa), times eV/Ha (27.2)
      real(dp), parameter :: MeC2 =  511004.0_dp
      REAL(dp), parameter :: HOnSqrtTwoMe = 23.1761_dp
      ! Me c / hbar = 2.5896 10^12 m^(-1) = 137.04188 a.u.^(-1)
      real(dp), parameter :: MeCOnHbar = 137.04188_dp

      end module constants

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_dimsmod.f90,v $:
! $Revision: 1.30 $
! $Author: jorissen $
! $Date: 2012/06/29 01:05:24 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module DimsMod
  ! This module contains dimensions for data arrays

! The file in which dimensions current to the calculation are saved :
  character*20, parameter :: dimFName = '.dimensions.dat'
! Set the following according to max. available memory on your system :
! The hardcoded limit on cluster size that can NEVER be exceeded :
  integer, parameter :: nclusxhardlimit = 3000
! The hardcoded upper limit on l-values that can NEVER be exceeded :
  integer, parameter :: lxhardlimit = 20
! The hardcoded upper limit on the number of potentials that can NEVER be exceeded :
  integer, parameter :: nphxhardlimit = 31
  private dimFName, lxhardlimit, nclusxhardlimit !! Meaning no other code can change these ...

  integer,parameter :: nclxtd = 100     ! Maximum number of atoms for tdlda module.
  integer,parameter :: nspx   = 1       ! Max number of spins: 1 for spin average; 2 for spin-dep
  integer,parameter :: natx   = 2500    ! Max number of atoms in problem for the pathfinder and ffsort
  integer,parameter :: nattx  = 2500   ! Max number of atoms in problem for the rdinp
  integer,parameter :: nphx   = 14      ! Max number of unique potentials (potph)
  integer,parameter :: ltot   = 24      ! Max number of ang mom (arrays 1:ltot+1)
  integer,parameter :: nrptx  = 1251    ! Loucks r grid used through overlap and in phase work arrays
  integer,parameter :: nex    = 500     ! Number of energy points genfmt, etc.
  integer,parameter :: lamtot = 15      ! Max number of distinct lambda's for genfmt 15 handles iord 2 and exact ss
  integer,parameter :: mtot   = 4       ! Vary mmax and nmax independently
  integer,parameter :: ntot   = 2 
  integer,parameter :: npatx  = 8       ! Max number of path atoms, used  in path finder, NOT in genfmt
  integer,parameter :: legtot = npatx+1 ! Matches path finder, used in GENFMT
  integer,parameter :: novrx  = 8       ! Max number of overlap shells (OVERLAP card)
  integer,parameter :: nheadx = 20+nphxhardlimit      ! Max number of header lines !KJ 7-09 added term to accomodate large systems in xsect.bin header
  integer,parameter :: MxPole = 1000    ! Max number of poles that can be used to model epsilon^-1 for HL multipole self energy
  integer,parameter :: nwordx = max(100,2+2*nphxhardlimit)     ! An infuriatingly stupid parameter that shows up in a few places. KJ added 7-09.  used to be 20 - must be at least 2*(1+nphx) for feff.bin header.
  integer,parameter :: novp = 40 ! For istprm, movrlp, ovp2mt - an atom list cutoff that should be high enough to include one atom of each potential type.  Added 2-2011 !KJ

! NON PARAMETER STATEMENTS
  integer :: nclusx    ! Maximum number of atoms for FMS.
  integer :: lx        ! Max orbital momentum for FMS module.

  ! OLD XPARAM.H MODULE
  integer,parameter :: natxx = natx
  integer,parameter :: nexx = nex
  integer,parameter :: nkmin = 1
  integer,parameter :: nphasx = nphx
  integer :: istatx

contains

  subroutine write_dimensions(nclusxuserlimit,lxuserlimit)
    implicit none
    ! Write dimension data to a file
	integer,intent(in) :: nclusxuserlimit,lxuserlimit
    integer :: ios  ! IO Status

!   3/ Apply hardcoded dimension limits
    if(nclusxuserlimit.gt.0) then
	   nclusx=min(nclusx,nclusxuserlimit)
	else
	   nclusx=min(nclusx,nclusxhardlimit)
	endif
    if(lxuserlimit.ge.0) then
	   lx=min(lx,lxuserlimit)
	else
       lx=min(lx,lxhardlimit)
	endif
    open(10,FILE=trim(dimFName),STATUS='unknown',FORM='formatted',IOSTAT=ios)
    call chopen(ios,trim(dimFName),'dimsmod')
    if (ios.ne.0) stop "Error writing dimensions.dat.  Quiting."
    
    write(10,*) nclusx,lx
    close(10)
  end subroutine write_dimensions


  subroutine init_dimensions
    implicit none
    ! Read dimensions from file
    integer :: ios  ! IO Status
    open(10,FILE=trim(dimFName),STATUS='old',FORM='formatted',IOSTAT=ios)
    call chopen(ios,trim(dimFName),'dimsmod')
    read(10,*) nclusx,lx
    close(10)
    ! OLD XPARAM DIMENSIONS
    istatx=(lx+1)**2*nclusx*nspx
  end subroutine init_dimensions


end module DimsMod

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_controls.f90,v $:
! $Revision: 1.7 $
! $Author: bmattern $
! $Date: 2012/02/09 18:04:57 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!*****************************************************************************
!       CONTROL THE WAY FEFF WORKS
!*****************************************************************************
      module controls
!    Switch to 1 for real space, 0 for reciprocal space
      integer spacy
!    Read sprkkr-structure file
      integer sprkkrstruct
!    Read sprkkr-potential file
      integer sprkkrpot
!    Read sprkkr-klist file
      integer sprkkrklist
!    Switch between real and complex spherical harmonics for the KKR structure factors
!    F for real, T for complex
      logical,parameter :: cplxylm=.false.
!    Arrays are allocated via kprep
      logical allocated
!    Use spin/relativistic matrices or not (LM basis) :
      integer irel
!    Set verbosity of SPRKKR subroutines
      integer iprint
!    Set up k-mesh in ffmod3
      logical makekmeshnow
!    Use a core hole or not
      logical corehole
!    Strength of the core hole - 1 is normal, 0 is nohole
      real*8 cholestrength       ! multiply core hole t-matrix by this number.  Currently strongly suggested to stay away from it!
!    Use single precision in strbbdd
      logical,parameter :: singleprec=.false.
!    Use full potential (t-matrix) or muffin tin potential (phases)
      logical fullpot      
      logical gglu_save_slice !BAM 2/2012

        CONTAINS
        subroutine init_controls
        spacy=1  ! real space
        sprkkrstruct=0
        sprkkrpot=0
        sprkkrklist=0
        makekmeshnow=.false. !use k-mesh from file
        allocated=.false.  ! not yet been in kprep
        irel=1  ! work in LM-basis
        iprint=0
        corehole=.false. !no core hole
        cholestrength=dble(1)
        open(96,file='ini.inp',status='old',err=2341)
        read(96,*,err=2341,end=2341) sprkkrstruct,sprkkrpot,sprkkrklist
        close(96)
2341    continue
        fullpot=(sprkkrpot.eq.1)
        gglu_save_slice = .false. ! BAM - save slice of g with n=0 in gglu
        return	          	
        end subroutine init_controls

        end module controls

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_kklist.f90,v $:
! $Revision: 1.8 $
! $Author: jorissen $
! $Date: 2012/01/30 06:01:58 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!*****************************************************************************
!       THE K-MESH TO SAMPLE THE BRILLOUIN ZONE
!*****************************************************************************
        module kklist
!    Number of k-points for the BZ mesh
      integer nkp
!    BZ mesh size, specified as nkx x nky x nkz
     integer nkx,nky,nkz
!    Use symmetry (1) or not (0) for this mesh
      integer usesym
!    Type of k-mesh
      integer ktype
	  ! ktype=1  :  regular mesh of nkp points for all modules
	  ! ktype=2  :  use nkp points for ldos/fms and nkp/5 points for pot  (significant time savings)
	  ! ktype=3  :  use nkp points for ldos/fms and nkp/5 points for pot (near edge) ; reduce nkp for all modules as we get away from near-edge
!    Rotation matrices for spherical harmonics
      !complex*16 drot(32,32,48,2)  !lx=3
      complex*16 drot(50,50,48,2)   !lx=4
        complex*16, allocatable :: mrot(:,:,:)
!    The k-mesh itself!
      real*8, allocatable :: bk(:,:)
!    Corresponding integration weights
      real*8, allocatable :: weight(:)
!    Sum of the integration weights
      real*8 sumweights
!    Correspondence between wien2k and sprkkr symmetry matrices
      integer symid(2,48)
!    Arrays that code for the relation between full and reduced k-mesh
      integer,allocatable :: intn(:),inti(:,:,:)
!    Which symmetries are actually used for the k-mes
      integer symact(48)
!    More arrays
      real*8,allocatable :: intw(:,:)


      CONTAINS
          subroutine init_kklist(n,nsym) !KJ 6-09
!            use struct,only: nsym !KJ 6-09
            implicit none
            integer,intent(in) :: n,nsym !KJ added nsym 6-09
            allocate(bk(3,n),weight(n))
            allocate(intn(n),inti(n,nsym,2),intw(n,nsym))
            intn=0
            inti=0
            intw=dble(0)
            symact=0
            bk=dble(0)
            weight=dble(0)
            sumweights=dble(0)
            symid=0
          end subroutine init_kklist

          subroutine destroy_kklist
		     if(allocated(bk)) deallocate(bk)
		     if(allocated(weight)) deallocate(weight)
		     if(allocated(inti)) deallocate(inti)
		     if(allocated(intn)) deallocate(intn)
		     if(allocated(intw)) deallocate(intw)
          end subroutine destroy_kklist

        end module kklist

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_strfacs.f90,v $:
! $Revision: 1.4 $
! $Author: jorissen $
! $Date: 2011/11/23 22:57:43 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!*****************************************************************************
!       THE KKR STRUCTURE FACTORS
!*****************************************************************************
        module strfacs
!    Ewald parameter
      real*8 streta
!    R-space cutoff
      real*8 strrmax
!    K-space cutoff
      real*8 strgmax
!    Energy broadening
      real*8 eimag
!    Structure factor
        complex,allocatable :: gk(:,:,:)

      CONTAINS
          subroutine init_strfacs
           !streta=dble(0)
           !strrmax=dble(0)
           !strgmax=dble(0)
           eimag=dble(0)
!	   open(98,file='eimag.txt',err=1010)
!	   read(98,*,err=1010,end=1010) eimag
!	   close(98)
           return
1010       eimag=dble(0);return
          end subroutine init_strfacs
        subroutine init_gk(n,j)
           implicit none
           integer n,j
           allocate(gk(n,n,j))  !nkkrmax,nkkrmax,nemax,nktabmax)
           gk=cmplx(0,0)
          end subroutine init_gk
          subroutine exit_gk
           deallocate(gk)
          end subroutine exit_gk

        end module strfacs

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_struct.f90,v $:
! $Revision: 1.12 $
! $Author: jorissen $
! $Date: 2012/01/31 22:47:21 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!*****************************************************************************
!       DEFINE THE UNIT CELL
!*****************************************************************************
      module struct

!    The space group
      integer sgroup  ! goes from 1 to 230
!    The H-M name of the space group
      character*8 sgroup_hm	  
!    The Bravais lattice
      character*3 latticename ! can be P,F,H,R,B,CXZ,CYZ
!    Similar to the above; here we only want to know whether we're in the "primitive" lattice or a "conventional" lattice	  
      character*1 lattice  ! allowed values :  P,F,I,B,C
!    The lattice constants
      real*8 alat(3),alfalat(3)
!    The lattice vectors
      real*8 a1(3),a2(3),a3(3)
!    The reciprocal lattice vectors
      real*8 b1(3),b2(3),b3(3)
!    Number of atoms
      integer nats
!    Number of potentials
      integer nph
!    Number of atoms per potential type
      integer,allocatable :: natom(:)
!    Index of representative atom for a potential type in the list of the atom positions of the unit cell
      integer,allocatable :: firstpos(:)	  
!    Positions of all atoms
      real*8, allocatable :: ppos(:,:)
!    Potential type of each position
      integer, allocatable :: ppot(:)
!    Position containing the absorber
      integer absorber
!    Angular expansion limit of potential
      integer,allocatable :: lpot(:)
!    Atom type for each potential
      character*2,allocatable :: label(:)
!    Atomic number z for each potential
      integer,allocatable :: izatom(:)	  
!    Number of spin states
      integer nsp
!    Volume of the unit cell :
      real*8 celvol
!    Volume of the reciprocal unit cell
      real*8 volbz
!    Symmetry operations of the crystal
      real*8 cryst_gr(3,4,48,2)
!     cryst_gr(:,:,:,2) : in lattice coordinates
!     cryst_gr(:,:,:,1) : in carthesian coordinates
!    Number of symmetry operations of the crystal
      integer nsym
!    The Bravais matrix, in units 2 pi / a_i
      real*8 bramat(3,3)
!    Real space basis matrix
      real*8 rbas(3,3)
!    Reciprocal space basis matrix
      real*8 gbas(3,3)
!    Is the real space basis orthogonal or not
      logical ortho

        CONTAINS

        subroutine init_struct(n)
        implicit none
        integer n


		if(allocated(ppos)) write(*,*) 'ppos is allocated'
		if(allocated(ppot)) write(*,*) 'ppot is allocated'
		if(allocated(lpot)) write(*,*) 'lpot is allocated'
		if(allocated(natom)) write(*,*) 'natom is allocated'

        allocate(ppos(3,n),ppot(n),lpot(0:n),natom(n),label(0:n),izatom(0:n),firstpos(n))
        ppos=dble(0)
        natom=0
        ppot=-1
        lpot=-1
		label(:)='     '
        if(absorber.lt.1.or.absorber.gt.n) absorber=1
        if( (latticename.ne.'P  '.and.latticename.ne.'F  '.and.latticename.ne.'I  '.and.latticename.ne.'CXZ'.and.latticename.ne.'CYZ'.and.latticename.ne.'H  ' &
		       .and.latticename.ne.'R'.and.latticename.ne.'B  '.and.latticename.ne.'CXY')  .or.  &
            (lattice.ne.'P'.and.lattice.ne.'F'.and.lattice.ne.'I'.and.lattice.ne.'C'.and.lattice.ne.'H'.and.lattice.ne.'R'.and.lattice.ne.'B')  ) then
		   call wlog('Setting unknown lattice type '//latticename//' '//lattice//'  to P.')
		   lattice='P'
		   latticename='P  '
		endif
        if(sgroup.lt.1.or.sgroup.gt.230) sgroup=1
        ortho=.false.
        gbas=dble(0)
        rbas=dble(0)
        bramat=dble(0)
        cryst_gr=dble(0)
        nsym=0

        end subroutine init_struct

        end module struct

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_inpmodules.f90,v $:
! $Revision: 1.61 $
! $Author: jorissen $
! $Date: 2012/10/23 20:08:40 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     This file written by Kevin Jorissen 7-09

!     THIS FILE REPLACES ALLINP.H AND MOST OF WRTALL.F90, INIALL.F90.


!     LAYOUT - PLEASE READ FIRST !!
!     Each module contains :
!      - a list of variables and parameters
!      - a module_write subroutine to write variables to a module.inp file
!      - a corresponding module_read subroutine
!      - a module_init subroutine to specify default values

!     Note to programmers : use of implicit none for each module MANDATORY
!     since a small mistake here could otherwise have very messy repercussions.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!     We're getting so many input parameters, some of them optional, that passing them through "rdmodxinp" subroutines is getting messy.
!     It also makes updating options difficult and messy.

!     FEFF is set up in the following way : each subprogram starts by reading a file containing all the settings that determines how it should run.
!     Hence, manipulation of this single file allows the user to tweak any subprogram.
!     However, obviously some variables control more than one subprogram.
!     Still they can belong to only one module!
!     To keep things manageable, such variables will either be put in the global_inp module ;
!     or in the module of the first subprogram (first w.r.t. normal program flow) that needs it.
!     All other modules will then have to call the first module with a "use module_x, only : var_x" statement.
!     The choice is sometimes a bit arbitrary.

!     Note that the only alternative would be to make the input files such that each variable occurs only once.
!     This would make the modules much cleaner, ie no use statements necessary.
!     However, it would then be less easy for the user to see which variables affect a particular subprogram he wants to run.
!     Also, changing the input file would then affect all subprograms needing that input file.
!     (This is already the case for quite a few input files, such as eels.inp, reciprocal.inp, global.inp, ...)


!     Ideally, in the future, defaults will be set as private parameters in each module's INIT subroutine.
!     Then, input files might not have to contain some optionals, and parameters could be defined free-format using XML.

!     Even more ideally, in a very distant future, each line will contain only one variable declaration
!     paired with a comment line describing its function ...



!     I REALLY THINK IT'S BEST TO KEEP ALL THESE MODULES IN ONE FILE ; or at least in a separate folder so they don't get mixed up
!     with everything else ...






!=======================================================================
!     GEOMETRY
!=======================================================================

      module geometry_inp
	    use dimsmod, only: nattx
		implicit none
	!c    atoms.dat
		integer  natt
		integer iphatx(nattx)
		double precision  ratx(3,nattx)

		contains

		subroutine geometry_write_atoms
			integer iat
                         double precision distance
			!c    atoms.dat to be read by ffsort, which will write smaller geom.dat file
			open (file='atoms.dat', unit=3, status='unknown')
			  write (3, 35) natt
		  35    format ('natx =  ', i7)
			  write (3, 10) '    x       y        z       iph  '
			  do iat = 1, natt
                               distance=dsqrt((ratx(1,iat)-ratx(1,1))**2+(ratx(2,iat)-ratx(2,1))**2+(ratx(3,iat)-ratx(3,1))**2) ! core hole should be in position 1 by now
				write(3,36) ratx(1,iat), ratx(2,iat), ratx(3,iat), iphatx(iat), distance
		  36      format( 3f13.5, i4, f13.5)
			  enddo
			close(3)
		  10  format(a)
		  20  format (20i4)
		  30  format (9f13.5)
		end subroutine geometry_write_atoms

		subroutine geometry_init
			natt = 0
			iphatx(:) = -1
			ratx(:,:) = 0.d0 !KJ added 7-09
		end subroutine geometry_init

      end module


!=======================================================================
!     ATOMS
!=======================================================================

	  module atoms_inp
	  ! The geom.dat file
	    use dimsmod,only: natx,nphx,nheadx
        implicit none
	    integer nat, nph, iatph(0:nphx), iphat(natx), ibounc(natx)
		! ibounc is currently set to 1 for all atoms in ffsort.  Path uses it.  Probably discontinued variable but ah well. !KJ
	    double precision  rat(3,natx)
		character(*),parameter,private :: filename='geom.dat'
!		iphat(natx)  -  given specific atom, which unique pot?
!		rat(3,natx)  -  cartesian coords of specific atom
!		iatph(0:nphx)  - given unique pot, which atom is model?
!                      (0 if none specified for this unique pot)

		contains

		subroutine atoms_read
	!		Read  geom.dat file
                       implicit none
		    character*512 slog
			character*80 head(nheadx)
			integer lhead(nheadx),j,j1,nhead
                        real*8 rdum1(3)
                        integer idum1,idum2
			open (file=filename, unit=3, status='old')
!			read header
			nhead = nheadx
			call rdhead (3, nhead, head, lhead)
			nat = 0
		    nph = 0
			iatph(:)=0
  50		continue
!KJ I switched up statements below so that code doesn't falsely abort when nat=natx.
!KJ			nat = nat+1
			if (nat .gt. natx)  then
              write(slog,'(a, 2i10)') ' nat, natx ', nat, natx
              call wlog(slog)
              stop 'Bad input'
			endif
                        read(3,*,end=60) j1,rdum1(1:3),idum1,idum2
			nat = nat+1
                        rat(1:3,nat)=rdum1(1:3)
                        iphat(nat)=idum1
                        ibounc(nat)=idum2
!KJ			read(3,*,end=60)  j1, (rat(j,nat),j=1,3), iphat(nat), ibounc(nat) !KJ j2  !KJ put ibounc back in for program PATH
			if (iphat(nat).gt.nph) nph = iphat(nat)
			if ( iatph(iphat(nat)).eq.0) iatph(iphat(nat)) = nat
			goto 50
  60		continue
!KJ			nat = nat-1
			close(3)
		end subroutine atoms_read

	  end module




!=======================================================================
!     GLOBAL
!=======================================================================

      module global_inp
        implicit none
	!	the variables evnorm, xivnorm, spvnorm and l2lp are exclusive to nrixs (feffq) calculations
	!	le2 has different meaning for feffq calculations
	!	xivec serves many different functions depending on spectroscopy : xas/eels/nrixs
		integer do_nrixs,lj,ldecmx !KJ 7-09 for feff8q
	!	configuration average data :
		integer nabs, iphabs
		real*8 rclabs
	!	global polarization data :
		integer ipol, ispin, le2, l2lp
		real*8 elpty, angks
		real*8 evec(3), xivec(3), spvec(3)
		complex*16 ptz(-1:1,-1:1)
		double precision evnorm, xivnorm, spvnorm
	!   moved here because I think it belongs here !KJ 7-09
		integer ispec
		character(*),parameter,private :: filename='global.inp'  !KJ used to be global.dat !!!
!       How many q-vectors:  (impulse transfer)		
		integer nq
!       Are we doing direction averaged impulse transfer?  (Note: this means q || e_z, which is not really averaging!)		
		logical qaverage
!       The list of q-vectors and their norm:		
		real*8,allocatable :: qs(:,:),qn(:)
!       Weights of q-vectors in the cross-section (probably calculated by another code):
        complex*16,allocatable :: qw(:)		
!       Are we doing q,q' crossterms in the NRIXS code?
        logical mixdff
!       If entering q, q' as length(q), length(q'), angle(q,q'), this is cosine(angle(q,q'))
        real*8,allocatable :: cosmdff(:,:)		
!       and this is norm(q')
        real*8 qqmdff
!       A rotation matrix for each q-vector  (containing cos(theta),sin(theta),cos(fi),sin(fi) for each q)
        real*8,allocatable :: qtrig(:,:)  !compare to Adam's code qtrig(iq,1)=qcst(iq); 2)=qsnt; 3)=qcsf; 4)=qsnf
!       Should the mdff program run? !11-2010
        integer imdff

		contains

		subroutine init_feffq
	!	called to calculate some variables for nrixs
			integer i
			evnorm=0.0d0
			xivnorm=0.0d0
			spvnorm=0.0d0
			do i=1,3
			   evnorm=evnorm+evec(i)*evec(i)
			   xivnorm=xivnorm+xivec(i)*xivec(i)
			   spvnorm=spvnorm+spvec(i)*spvec(i)
			end do
			spvnorm=sqrt(spvnorm)
			xivnorm=sqrt(xivnorm)
			evnorm=sqrt(evnorm)
		end subroutine init_feffq

		subroutine global_write(iniq)
			integer i
			logical,intent(in) :: iniq
			if(iniq) call init_feffq
			open (file=filename, unit=3, status='unknown')
			write (3, 10) ' nabs, iphabs - CFAVERAGE data'
			write (3, 45) nabs, iphabs, rclabs
		  45	  format ( 2i8, f13.5)
			write (3,10) ' ipol, ispin, le2, elpty, angks, l2lp, do_nrixs, ldecmx, lj' !KJ last 4 added for feff8q.  Note le2 new meaning in feff8q
			write (3, 50)  ipol, ispin, le2, elpty, angks, l2lp, do_nrixs, ldecmx, lj !KJ
		  50	  format ( 3i5, 2f12.4, 10i5)  !KJ
			write (3, 10) 'evec		  xivec 	   spvec'
			do 60 i = 1,3
			write (3,30) evec(i), xivec(i), spvec(i)
		  60	  continue
			write (3, 10) ' polarization tensor '
			do 70 i = -1, 1
				write(3,30) dble(ptz(-1,i)), dimag(ptz(-1,i)), dble(ptz(0,i)), dimag(ptz(0,i)),  dble(ptz(1,i)), dimag(ptz(1,i))
		  70	  continue
		!KJ for feff8q - was in different place in file in feff8q:
			write(3,10) 'evnorm, xivnorm, spvnorm - only used for nrixs'
			write (3,30) evnorm, xivnorm, spvnorm !KJ
		!KJ for a list of q-vectors (NRIXS) and MDFF calculation (NRIXS) - only relevant for NRIXS calculations  12-2010
			write(3,10) "nq,    imdff,   qaverage,   mixdff"
			   write(3,*) nq,imdff,qaverage,mixdff
			write(3,*) 'q-vectors : qx, qy, qz, q(norm), weight, qcosth, qsinth, qcosfi, qsinfi'
			if(nq.gt.0) then    !note that this is redundant with xivec if nq=1, but ah well.
			   do i=1,nq
			      write(3,30) qs(i,:),qn(i),qw(i),qtrig(i,1:4)
			   enddo
	        endif 
			if(mixdff) then
			   write(3,*) "   qqmdff,   cos<q,q'>"
			   write(3,*) qqmdff,cosmdff
		    endif
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (20f13.5)

		end subroutine global_write

		subroutine global_read
			real*8 aa1,bb1,aa2,bb2,aa3,bb3
			integer i
			open (file=filename, unit=3, status='old')
			read  (3,*)
			read  (3,*) nabs, iphabs, rclabs
			read  (3,*)
			read  (3,*)  ipol, ispin, le2, elpty, angks, l2lp, do_nrixs, ldecmx, lj
			read  (3,*)
			do i = 1,3
			  read  (3,*) evec(i), xivec(i), spvec(i)
			enddo
			read  (3,*)
			do i = -1, 1
			  read (3,*) aa1, bb1, aa2, bb2, aa3, bb3 !KJ changed names of dummies to avoid confusion with my WELL DEFINED arrays (f*cking "implicit" people !#$&%)
			  ptz(-1,i)= dcmplx(aa1,bb1)  !KJ changed cmplx to dcmplx to satisfy thorough compilers
			  ptz(0,i) = dcmplx(aa2,bb2)
			  ptz(1,i) = dcmplx(aa3,bb3)
			enddo
			read (3,*)
			read (3,*) evnorm, xivnorm, spvnorm !KJ
			if(do_nrixs .ne. 0) then !compatibility with (most) old files
		       read(3,*) 
			   read(3,*) nq,imdff,qaverage,mixdff
			   read(3,*)
			   call make_qlist(nq)
			   if(nq.gt.0) then    !note that this is redundant with xivec if nq=1, but ah well.
			      do i=1,nq
			         read(3,30) qs(i,:),qn(i),qw(i),qtrig(i,1:4)
			      enddo
	           endif  
			   if(mixdff) then
			      read(3,*) 
				  read(3,*) qqmdff,cosmdff
			   endif
	  30  format (20f13.5)
			endif
			close(3)
		end subroutine global_read
		
		subroutine make_qlist(n)
		    implicit none
			integer,intent(in) :: n
			allocate(qs(n,3),qn(n),qw(n),qtrig(n,4),cosmdff(n,n))
			qs(:,:)=0.d0
			qn(:)=0.d0
			qw(:)=1.d0
			qtrig(:,:)=0.d0
			qtrig(:,1)=1.d0
			qtrig(:,3)=1.d0 !corresponding to not rotating at all
			cosmdff(:,:)=1.d0
		    return
		end subroutine make_qlist

        subroutine make_qtrig
!          simple routine to get rotation angles; copied from mkptz      
           implicit none
           double precision rr,rsp
           integer iq
	       do iq=1,nq
              if (qn(iq).gt.0.0d0) then
                 rsp = qn(iq)
                 rr = qs(iq,1)**2 + qs(iq,2)**2
				 if (rr.eq. 0) then
					qtrig(iq,1) = - 1.d0
					qtrig(iq,2) = 0.d0
					qtrig(iq,3) = 1.d0
					qtrig(iq,4) = 0.d0
				elseif (qs(iq,3).lt.0) then !meaning forward scattering ??
!                  rotation is defined by angles theta and fi
				   rr = sqrt(rr)
				   qtrig(iq,1) = qs(iq,3) / rsp
				   qtrig(iq,2) = rr / rsp
				   qtrig(iq,3) = qs(iq,1) / rr
			       qtrig(iq,4) = qs(iq,2) / rr
				else 
                   qtrig(iq,1)=1.0d0
                   qtrig(iq,2)=0.0d0
                   qtrig(iq,3)=1.0d0 !surely this is a bug??  Shouldn't this be 1? !KJ 12-2011 changed 0->1 because produces NaN in genfmt otherwise
                   qtrig(iq,4)=0.0d0
				end if
              else
                 call wlog(' FATAL error: one of the q-vectors is zero')
                 call par_stop(' ') 
              endif
		   enddo !iq  
           return 
        end subroutine make_qtrig		

		subroutine global_init
			ispec = 0
			ldecmx=-1 ! initialize the number of decomposition channels - KJ 7-09 for feff8q
			nabs = 1
			iphabs = 0
			rclabs = 0.d0
			ipol = 0
			ispin = 0
			le2 = 0
			l2lp = 0
			elpty = 0.d0
			angks = 0.d0
			evec(:) = 0.d0
			xivec(:) = 0.d0
			spvec(:) = 0.d0
			ptz(:,:) = cmplx(0.d0,0.d0)
			evnorm=0.0d0
			xivnorm=0.0d0
			spvnorm=0.0d0
			do_nrixs=0 ! no nrixs calculation
			lj = -1
			nq=0
			qaverage=.true.
			imdff=0 !no mdff
			mixdff=.false. !no mdff in NRIXS
		!	cosmdff=1.d0  ! q || q'  => cos(0)=1     !KJ 11-2011 this is now an allocatable array.  Instruction fails on gfortran.
			qqmdff=-1.d0 ! leads to q=q' (norm only)
		end subroutine global_init


	end module 



!=======================================================================
!     RECIPROCAL
!=======================================================================

      module reciprocal_inp
	!     k-space variables :
		use controls  !KJ 8/06
		use struct, nphstr => nph
		use kklist,only: nkp,usesym,nkx,nky,nkz,ktype
        use strfacs,only: streta,strrmax,strgmax,init_strfacs
		implicit none
		integer icorehole
		real*8 streimag ! additional broadening for calculation KKR structure factors ; not recommended
		character(*),parameter,private :: filename='reciprocal.inp'

		contains

		subroutine reciprocal_write
		!KJ next file added 8/06
		    integer i
			open (file=filename, unit=3, status='unknown')
		!       in which space are we?
			write(3,10) 'spacy'
			write(3,20) spacy
			if(spacy.eq.0) then
			   write(3,10) 'lattice vectors  (in A, in Carthesian coordinates)'
			   write(3,30) a1
			   write(3,30) a2
			   write(3,30) a3
			   write(3,10) 'Volume scaling factor (A^3); eimag; core hole'
			   write(3,30) dble(-1),dble(0),dble(1)
			   write(3,10) 'lattice type  (P,I,F,R,B,CXY,CYZ,CXZ)'
			   write(3,10) latticename
			   write(3,10) '#atoms in unit cell ; position absorber ; corehole?'
			   write(3,20) nats,absorber,icorehole
			   write(3,10) '# k-points total/x/y/z ; ktype; use symmetry?'
			   write(3,*) nkp,nkx,nky,nkz,ktype,usesym  ! format line 20 limits integer to 4 positions - not enough for nkp!
			   write(3,10) 'ppos'
			   do i=1,nats
				  write(3,30) ppos(:,i)
			   enddo
			   write(3,10) 'ppot'
			    !KJ bugfix 5/2012: It's important not to use formatting when there are more atoms than fit on one line!!			   
			   write(3,*) ppot
			   write(3,10) 'streta,strgmax,strrmax'
			   write(3,30) streta,strgmax,strrmax
				endif
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine reciprocal_write

		subroutine reciprocal_read(celvin)
		use struct, nphstr => nph
		integer i
		real*8,intent(out) :: celvin
        open (3,file=filename,status='unknown',err=167)
        read(3,*,end=167,err=167)
        read(3,*,end=167,err=167) spacy
        if(spacy.eq.0) then
             read(3,*) ; read(3,*) a1(:)
        	 read(3,*) a2(:)
        	 read(3,*) a3(:)
        	 read(3,*) ; read(3,*) celvin,streimag,cholestrength
        	 read(3,*) ; read(3,*) latticename
			 lattice=latticename(1:1)
             read(3,*) ; read(3,*) nats,absorber,icorehole
             read(3,*) ; read(3,*) nkp,nkx,nky,nkz,ktype,usesym
             read(3,*)
			 !Careful: the next statement used to be "if size(ppot).eq.0".  However, on ifort size(ppot)=0 but on gfortran it =1!!
			 !Hence the new instruction.
			 !I wish if(allocated(ppot)) would work here; I don't understand why it doesn't.
        	 if(size(ppot).lt.nats) call init_struct(nats) !KJ 7-09 bugfix call this only once ; I can't seem to use "allocated(ppos)" here?
	         do i=1,nats
	             read(3,*) ppos(:,i)
	         enddo
             read(3,*) ; read(3,*) ppot
             read(3,*) ; read(3,*) streta,strgmax,strrmax
			 if(icorehole.eq.1) then
				corehole=.true.
			 else
				corehole=.false.
			 endif
		endif
        return
167     spacy=1
        return
		end subroutine reciprocal_read

		subroutine reciprocal_init
			call init_controls
			call init_strfacs
			icorehole = 1  ! use core hole
			streimag = dble(0) ! no extra broadening for KKR struc factors
			cholestrength = dble(1) ! don't mess with core hole
		end subroutine reciprocal_init
        
	end module






!=======================================================================
!     POTENTIAL
!=======================================================================

      module potential_inp
		use dimsmod, only: nheadx, nphx, novrx
		use global_inp, only: ispec
		use atoms_inp, only : nph
		implicit none
		character(*),parameter,private :: filename='pot.inp'

		character*80 title(nheadx)
		integer mpot, ntitle, ihole, ipr1, iafolp, iunf,             &
			nmix, nohole, jumprm, inters, nscmt, icoul, lfms1, ixc
		integer iz(0:nphx)
!		iz(0:nphx)    - atomic number, input
		integer lmaxsc(0:nphx)
		real rfms1
		double precision gamach, rgrd, ca1, ecv, totvol
		double precision  xnatph(0:nphx), folp(0:nphx), spinph(0:nphx)
!		xnatph(0:nphx) - given unique pot, how many atoms are there
!                      of this type? (used for interstitial calc)
!		folp(0:nphx) -  overlap factor for rmt calculation
		double precision  xion(0:nphx)
!		xion(0:nphx)  - ionicity, input
		logical ExternalPot
	!     for OVERLAP option
	    logical StartFromFile
		! read potential from pot.bin file and start from there
		integer novr(0:nphx), iphovr(novrx,0:nphx), nnovr(novrx,0:nphx)
		double precision  rovr(novrx,0:nphx)
!		novr(0:nphx) -  number of overlap shells for unique pot
!		iphovr(novrx,0:nphx) -  unique pot for this overlap shell
!		nnovr(novrx,0:nphx) -   number of atoms in overlap shell
!		rovr(novrx,0:nphx)  -   r for overlap shell
		! Added by Fer
		! Used to correct the excitation energy for chemical shifts
		integer  ChSh_Type
		integer configtype !KJ 12-2010 : which method for choosing atomic configuration?
		double precision corval_emin  !KJ 12-2012 defines energy window for search for core-valence separation energy.

!       criteria for self-consistency
        real*8,parameter :: tolmu = 1.D-3  ! Fermi level (Ha)
        real*8,parameter :: tolq = 1.D-3   ! net charge on atom iph (e)
	    real*8,parameter :: tolqp = 2.D-4  ! partial charge (e.g. l=1) on atom iph (e)
	    real*8,parameter :: tolsum = 0.05  ! total valence charge in Norman sphere compared to formal valence charge


		contains

		subroutine potential_write
			integer ititle,ip,iph,iovr			
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'mpot, nph, ntitle, ihole, ipr1, iafolp, ixc,ispec'
			  write(3,20) mpot, nph, ntitle, ihole, ipr1, iafolp, ixc, ispec
			  write(3,10) 'nmix, nohole, jumprm, inters, nscmt, icoul, lfms1, iunf'
			  write(3,20)  nmix, nohole, jumprm, inters, nscmt, icoul, lfms1, iunf
			  do ititle = 1, ntitle
		         write(3,10) title(ititle)
			  enddo
			  write(3,10) 'gamach, rgrd, ca1, ecv, totvol, rfms1, corval_emin'
			  write(3,30)  gamach, rgrd, ca1, ecv, totvol, rfms1, corval_emin
			  write(3,10) ' iz, lmaxsc, xnatph, xion, folp'
		  120   format ( 2i5, 4f13.5)
			  do ip = 0, nph
		        write(3,120) iz(ip), lmaxsc(ip), xnatph(ip), xion(ip), folp(ip)
			  enddo
			  write(3,10) 'ExternalPot switch, StartFromFile switch'
			  write(3,*) ExternalPot,StartFromFile
		!       for OVERLAP option
			  write(3,10) 'OVERLAP option: novr(iph)'
			  write(3,20) ( novr(iph), iph=0,nph)
			  write(3,10) ' iphovr  nnovr rovr '
		  140   format ( 2i5, f13.5)
			  do iph = 0, nph
			  do iovr = 1, novr(iph)
		         write(3,140) iphovr(iovr, iph), nnovr(iovr,iph), rovr(iovr,iph)
			  enddo
	          enddo
		! Added by Fer
		! Correction of the excitation energy for chemical shifts
			  write(3,10) 'ChSh_Type:'
			  write(3,20) ChSh_Type
			  write(3,10) 'ConfigType:'
			  write(3,20) configtype 
		close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine potential_write

		subroutine potential_read
			integer ititle,ip,iph,iovr	
			open (file=filename, unit=3, status='old')
			  read(3,*) ; read(3,*) mpot, nph, ntitle, ihole, ipr1, iafolp, ixc, ispec
			  read(3,*) ; read(3,*)  nmix, nohole, jumprm, inters, nscmt, icoul, lfms1, iunf
			  do ititle = 1, ntitle
		         read(3,*) title(ititle)
			  enddo
			  read(3,*) ; read(3,*)  gamach, rgrd, ca1, ecv, totvol, rfms1, corval_emin
			  read(3,*)
			  do ip = 0, nph
		        read(3,*) iz(ip), lmaxsc(ip), xnatph(ip), xion(ip), folp(ip)
			  enddo
			  read(3,*) ; read(3,*) ExternalPot, StartFromFile
			  read(3,*) ; read(3,*) (novr(iph), iph=0,nph)
			  read(3,*)
			  do iph = 0, nph
			  do iovr = 1, novr(iph)
		         read(3,*) iphovr(iovr, iph), nnovr(iovr,iph), rovr(iovr,iph)
			  enddo
	          enddo
			  read(3,*) ; read(3,*) ChSh_Type
			  read(3,*,end=55) ; read(3,*,end=55) configtype
			  55 continue
			close(3)
		end subroutine potential_read

		subroutine potential_init
			title(:) = ' '
			mpot = 1
			nph = 0
			ntitle = 0
			ihole = 1
			ipr1 = 0
			iafolp = 0
			iunf = 0
			nmix = 1
			nohole = -1
			jumprm = 0
			inters = 0
			nscmt = 0
			icoul = 0
			ixc = 0
			lfms1 = 0
			iz(:) = -1
			lmaxsc(:) = 0
			rfms1 = -1 * 1.e0
			ca1 = 0.d0
			ecv = -40*1.d0 
			rgrd = 0.05 * 1.d0
			totvol = 0.d0
			gamach = 0.d0 !initialized later by setgam
			xnatph(:) = 0.d0
			spinph(:) = 0.d0
			xion(:) = 0.d0
			folp(:) = 1.d0
		    ExternalPot = .false.
			StartFromFile = .false. !KJ added 12-10
			novr(:) = 0
			iphovr(:,:)=0 !KJ added 7-09
			nnovr(:,:)=0 !KJ
			rovr(:,:) = 0.d0 !KJ
			ChSh_Type = 0 !Fer : standard feff
			configtype=1 !KJ 12-2010 standard feff9
			corval_emin=-70.d0 ! eV
		end subroutine potential_init

	end module

!=======================================================================
!     LDOS
!=======================================================================

      module ldos_inp
	    use atoms_inp,only: nph
        use potential_inp,only: ixc, rgrd
		use global_inp,only: ispin
		use dimsmod,only : nphx
		implicit none
		character(*),parameter,private :: filename='ldos.inp'
		integer mldos, lfms2, minv, lmaxph(0:nphx)
		double precision emin, emax, eimag
		integer neldos
		real rdirec, toler1, toler2, rfms2
        logical save_g0, save_compton_info ! BAM 2/2012

		contains

		subroutine ldos_write
			integer iph
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'mldos, lfms2, ixc, ispin, minv, neldos'
			  write(3,20)  mldos, lfms2, ixc, ispin, minv, neldos
			  write(3,10) 'rfms2, emin, emax, eimag, rgrd'
			  write(3,30)  rfms2, emin, emax, eimag, rgrd
			  write(3,10) 'rdirec, toler1, toler2'
			  write(3,30)  rdirec, toler1, toler2
			  write(3,10) ' lmaxph(0:nph)'
			  write(3,20)  (lmaxph(iph),iph=0,nph)
			  write(3,10) 'save_g0? save_compton_info?'
			  write(3,*)  save_g0, save_compton_info
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine ldos_write

		subroutine ldos_read
			integer iph
			open (file=filename, unit=3, status='old')
			  read(3,*) ; read(3,*)  mldos, lfms2, ixc, ispin, minv, neldos
			  read(3,*) ; read(3,*)  rfms2, emin, emax, eimag, rgrd
			  read(3,*) ; read(3,*)  rdirec, toler1, toler2
			  read(3,*) ; read(3,*)  (lmaxph(iph),iph=0,nph)
			  read(3,*) ; read(3,*)  save_g0, save_compton_info
			close(3)
		end subroutine ldos_read

		subroutine ldos_init
			mldos = 0
			lfms2 = 0
			minv = 0
			emax = 0.d0
			emin = 1000*1.d0
			eimag = -1*1.d0
			neldos = 101
			rfms2 = -1 * 1.e0
			rdirec = -1 * 1.e0
			toler1 = 1.d-3
			toler2 = 1.d-3
			lmaxph(:) = 0
            save_g0 = .false.
            save_compton_info = .false.
		end subroutine ldos_init

	end module



!=======================================================================
!     SCREEN
!=======================================================================

      module screen_inp
	    use atoms_inp,only: nph		
		implicit none
		
                TYPE ScreenInputVars
                   integer ner, nei, maxl, irrh, iend, lfxc, nrptx0
                   double precision emin, emax, eimax, ermin, rfms
                END TYPE ScreenInputVars
                
                character(*),parameter,private :: filename='screen.inp'
                TYPE(ScreenInputVars) ScreenI

		contains

		subroutine screen_write
		           open(unit=3,file=filename,status='unknown')
				   write(3,*) 'ner',ScreenI%ner
				   write(3,*) 'nei',ScreenI%nei
				   write(3,*) 'maxl',ScreenI%maxl
				   write(3,*) 'irrh',ScreenI%irrh
				   write(3,*) 'iend',ScreenI%iend
				   write(3,*) 'lfxc',ScreenI%lfxc
				   write(3,*) 'emin',ScreenI%emin
				   write(3,*) 'emax',ScreenI%emax
				   write(3,*) 'eimax',ScreenI%eimax
				   write(3,*) 'ermin',ScreenI%ermin
				   write(3,*) 'rfms',ScreenI%rfms
				   write(3,*) 'nrptx0',ScreenI%nrptx0
                   close(3)
				   return
		end subroutine screen_write

        subroutine screen_inp_parse(str,vars)
		   implicit none
		   character*3,intent(in) :: str
		   real*8,intent(in) ::  vars
				if (str .eq. 'ner') then
				   ScreenI%ner   = vars
				elseif (str .eq. 'nei') then
				   ScreenI%nei   = vars
				elseif (str .eq. 'max') then
				   ScreenI%maxl  = vars
				elseif (str .eq. 'irr') then
				   ScreenI%irrh  = vars
				elseif (str .eq. 'ien') then
				   ScreenI%iend  = vars
				elseif (str .eq. 'lfx') then
				   ScreenI%lfxc  = vars
				elseif (str .eq. 'emi') then
				   ScreenI%emin  = vars
				elseif (str .eq. 'ema') then
				   ScreenI%emax  = vars
				elseif (str .eq. 'eim') then
				   ScreenI%eimax = vars
				elseif (str .eq. 'erm') then
				   ScreenI%ermin = vars
				elseif (str .eq. 'rfm') then
				   ScreenI%rfms  = vars
				elseif (str .eq. 'nrp')then
				   ScreenI%nrptx0  = vars
				else 
				   call wlog("Unrecognized keyword submitted to screen.inp in SCREEN_INP_PARSE ; aborting.")
				   stop
                endif
				return
		end subroutine screen_inp_parse

        subroutine screen_inp_parse_and_write(str,vars)
		!KJ No longer used (1-2012).  Used in a previous version of feff.
		   implicit none
		   character*3,intent(in) :: str
		   real*8,intent(in) ::  vars
		        open(unit=3,file=filename,status='unknown',access='append')
				if (str .eq. 'ner') then
				   ScreenI%ner   = vars
				   write(3,*) 'ner',ScreenI%ner
				elseif (str .eq. 'nei') then
				   ScreenI%nei   = vars
				   write(3,*) 'nei',ScreenI%nei
				elseif (str .eq. 'max') then
				   ScreenI%maxl  = vars
				   write(3,*) 'maxl',ScreenI%maxl
				elseif (str .eq. 'irr') then
				   ScreenI%irrh  = vars
				   write(3,*) 'irrh',ScreenI%irrh
				elseif (str .eq. 'ien') then
				   ScreenI%iend  = vars
				   write(3,*) 'iend',ScreenI%iend
				elseif (str .eq. 'lfx') then
				   ScreenI%lfxc  = vars
				   write(3,*) 'lfxc',ScreenI%lfxc
				elseif (str .eq. 'emi') then
				   ScreenI%emin  = vars
				   write(3,*) 'emin',ScreenI%emin
				elseif (str .eq. 'ema') then
				   ScreenI%emax  = vars
				   write(3,*) 'emax',ScreenI%emax
				elseif (str .eq. 'eim') then
				   ScreenI%eimax = vars
				   write(3,*) 'eimax',ScreenI%eimax
				elseif (str .eq. 'erm') then
				   ScreenI%ermin = vars
				   write(3,*) 'ermin',ScreenI%ermin
				elseif (str .eq. 'rfm') then
				   ScreenI%rfms  = vars
				   write(3,*) 'rfms',ScreenI%rfms
				elseif (str .eq. 'nrp')then
				   ScreenI%nrptx0  = vars
				   write(3,*) 'nrptx0',ScreenI%nrptx0
				else 
				   call wlog("Unrecognized keyword submitted to screen.inp ; aborting.")
				   stop
                endif
				close(3)
				return
		end subroutine screen_inp_parse_and_write


		subroutine screen_read
		    ! Reads screen.inp.  This routine is set up a little different from its brothers in the other input modules.
			! This is to keep it compatible with situations where there either is no screen.inp file (in which case defaults are used for all variables),
			! and with situations where screen.inp contains only the variables for which non-default values are specified.
			! This is because I've only added mandatory screen.inp files being written by rdinp now 1-2012.  KJ
			integer i
			character*8 strs
			character*3 str
			double precision vars
			call screen_init  !KJ set defaults in case screen.inp doesn't exist!
			open (file=filename, unit=3, status='old', err=60)
!KJ			read (3,*)  !KJ 11-2011 removing header line from screen.inp because it is incompatible with screen_inp_and_parse above.
			do i = 1, 12
				read(3,*,end=60)  strs, vars
				str = strs(1:3)
				if (str .eq. 'ner') ScreenI%ner   = nint(vars)
				if (str .eq. 'nei') ScreenI%nei   = nint(vars)
				if (str .eq. 'max') ScreenI%maxl  = nint(vars)
				if (str .eq. 'irr') ScreenI%irrh  = nint(vars)
				if (str .eq. 'ien') ScreenI%iend  = nint(vars)
				if (str .eq. 'lfx') ScreenI%lfxc  = nint(vars)
				if (str .eq. 'emi') ScreenI%emin  = vars
				if (str .eq. 'ema') ScreenI%emax  = vars
				if (str .eq. 'eim') ScreenI%eimax = vars
				if (str .eq. 'erm') ScreenI%ermin = vars
				if (str .eq. 'rfm') ScreenI%rfms  = vars
				if (str .eq. 'nrp') ScreenI%nrptx0  = nint(vars)
			end do
		  60 continue
		  close(3)
                  return
		end subroutine screen_read

		subroutine screen_init
		  ScreenI%ner   = 40
		  ScreenI%nei   = 20
		  ScreenI%maxl  = 4
		  ScreenI%irrh  = 1
		  ScreenI%iend  = 0
		  ScreenI%emin  = -40.0d0 !KJ This and next 3 values are in eV ; converted to Ha at a later point in the code (screen/rdgeom.f90)
		  ScreenI%emax  = 0.0d0
		  ScreenI%eimax = 2.0d0
		  ScreenI%ermin = 0.001d0
		  ScreenI%lfxc  = 0
		  ScreenI%rfms  = 4.0d0
		  ScreenI%nrptx0 = 251
		end subroutine screen_init

	end module


!=======================================================================
!     OPCONS
!=======================================================================
      MODULE opcons_inp
        USE dimsmod
        LOGICAL run_opcons, print_eps
        REAL(8) NumDens(0:nphx)
		character(*),parameter,private :: filename='opcons.inp'		
        
        CONTAINS
           SUBROUTINE opcons_init
              run_opcons = .FALSE.
              print_eps  = .FALSE.
              NumDens(:) = -1.d0
           END SUBROUTINE opcons_init

           SUBROUTINE opcons_write
              INTEGER iph

              OPEN(FILE=filename,UNIT=8,STATUS='REPLACE')

              WRITE(8,'(A)') 'run_opcons'
              WRITE(8,*) run_opcons
              WRITE(8,'(A)') 'print_eps'
              WRITE(8,*) print_eps
              WRITE(8,'(A)') 'NumDens(0:nphx)'
              WRITE(8,*) NumDens(0:nphx)

              CLOSE(8)
           END SUBROUTINE opcons_write

           SUBROUTINE opcons_read
              INTEGER iph

              OPEN(FILE=filename,UNIT=8,STATUS='OLD')

              READ(8,*)
              READ(8,*) run_opcons
              READ(8,*)
              READ(8,*) print_eps
              READ(8,*)
              READ(8,*) NumDens(0:nphx)
           END SUBROUTINE opcons_read

      END MODULE opcons_inp
!=======================================================================
!     XSPH
!=======================================================================

      module xsph_inp
        use dimsmod
		use global_inp
		use potential_inp
		use ldos_inp
		implicit none
		character(*),parameter,private :: filename='xsph.inp'
		integer mphase, ipr2, ixc0, lreal, iPlsmn
		integer iGammaCH, iGrid, NPoles
		character*6  potlbl(0:nphx)
!		potlbl(0:nphx)    -   label for user convienence
		double precision xkstep, xkmax, vixan, vr0, vi0, Eps0, EGap
		integer izstd, ifxc, ipmbse, itdlda, nonlocal, ibasis
!		!KJ for the energy grid card EGRID :
		integer iegrid,egrid3a
		real*8 egrid3b,egrid3c
		character*100 egridfile
                logical lopt

		contains

		subroutine xsph_write
			integer iph
			open (file=filename, unit=3, status='unknown')
		!     Josh - added flag for PLASMON card (iPlsmn = 0, 1, or 2)
			  write(3,10) 'mphase,ipr2,ixc,ixc0,ispec,lreal,lfms2,nph,l2lp,iPlsmn,NPoles,iGammaCH,iGrid'
			  write(3,20)  mphase,ipr2,ixc,ixc0,ispec,lreal,lfms2,nph,l2lp,   &
			 &        iPlsmn, NPoles, iGammaCH, iGrid
			  write(3,10) 'vr0, vi0'
			  write(3,30)  vr0, vi0
			  write(3,10) ' lmaxph(0:nph)'
			  write(3,20)  (lmaxph(iph),iph=0,nph)
			  write(3,10) ' potlbl(iph)'
			  write(3,170)  (potlbl(iph),iph=0,nph)
		  170   format (13a6)
			  write(3,10) 'rgrd, rfms2, gamach, xkstep, xkmax, vixan, Eps0, EGap'
			  write(3,30)  rgrd, rfms2, gamach, xkstep, xkmax, vixan, Eps0, EGap
			  write(3,30)  (spinph(iph),iph=0,nph)
			  write(3,20)  izstd, ifxc, ipmbse, itdlda, nonlocal, ibasis
			! Commented out by Fer
			! The following lines are commented out because they are not being read
			! in rexsph (commented out by JK). This screws up anything that comes after
			! them in mod2.inp (for example, the ChSh parameters that I'm including.
			!!KJ next lines contain EGRID variables ; added 01-07
			!        write(3,10) 'iegrid,egrid3a,egrid3b,egrid3c'
			!          write(3,'(2i4,2f13.5)') iegrid,egrid3a,egrid3b,egrid3c !format statement is a mix of 20 and 30
			!          write(3,10) 'egridfile'
			!          write(3,10) egridfile
			!!KJ
			! Added by Fer
			! Correction of the excitation energy for chemical shifts
			  write(3,10) 'ChSh_Type:'
			  write(3,20) ChSh_Type
			!KJ 7-09 Next 2 lines for feff8q
			  write(3,'(a)') ' the number of decomposition channels ; only used for nrixs'
			  write(3,'(i5)') ldecmx
                          write(3,'(a)') 'lopt'
                          write(3,*) lopt
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (20f13.5)
		end subroutine xsph_write

		subroutine xsph_read
			integer iph
			open (file=filename, unit=3, status='old')
			  read(3,*) ; read(3,*)  mphase,ipr2,ixc,ixc0,ispec,lreal,lfms2,nph,l2lp,iPlsmn, NPoles, iGammaCH, iGrid
			  read(3,*) ; read(3,*)  vr0, vi0
			  read(3,*) ; read(3,*)  (lmaxph(iph),iph=0,nph)
			  read(3,*) ; read(3,'(13a6)')  (potlbl(iph),iph=0,nph)
			  read(3,*) ; read(3,*)  rgrd, rfms2, gamach, xkstep, xkmax, vixan, Eps0, EGap
			  read(3,*)  (spinph(iph),iph=0,nph)
			  read(3,*)  izstd, ifxc, ipmbse, itdlda, nonlocal, ibasis
			!!KJ next lines contain EGRID variables ; added 01-07
			!          read(3,*) ; read(3,'(2i4,2f13.5)') iegrid,egrid3a,egrid3b,egrid3c !format statement is a mix of 20 and 30
			!          read(3,*) ; read(3,10) egridfile
			  read(3,*) ; read(3,*) ChSh_Type
			!KJ 7-09 Next 2 lines for feff8q
			  read(3,*) ; read(3,*) ldecmx
                        read(3,*) ; read(3,*) lopt
			close(3)
		end subroutine xsph_read

		subroutine xsph_init
                        lopt = .false.
			izstd = 0
			ifxc = 0
			ipmbse = 0
			itdlda = 0
			nonlocal = 0
			ibasis = 0
			potlbl(0:nphx) = ' '
			mphase = 1
			ipr2 = 0
			ixc0 = -1
			lreal = 0
			iPlsmn = 0 ! Josh Kas
                        NPoles = 100 ! JJK 3/9/2010
                        EGap = 0.d0 ! JJK 4/2010
			iGammaCH = 0
			iGrid = 0
			vr0 = 0.d0
			vi0 = 0.d0
			xkmax = 20*1.d0
			xkstep = 0.07*1.d0
			vixan = 0.d0
			iegrid=0 !KJ for EGRID card 1-07
			egridfile=' '
			egrid3a=0
			egrid3b=dble(0)
			egrid3c=dble(0)
		end subroutine xsph_init


      end module



!=======================================================================
!     FMS
!=======================================================================

      module fms_inp
        use ldos_inp
		use global_inp,only: ldecmx
		implicit none
		character(*),parameter,private :: filename='fms.inp'
		integer mfms, idwopt, ipr3 !ipr3 is currently dummy - not in fms.inp
		real rprec
		!KJ rprec seems to be bogus input, i.e. not used anywhere in entire FEFF90.  Set to 0 and kept here for compatibility.
		double precision   tk, thetad, sig2g

		contains

		subroutine fms_write
			implicit none
			integer iph
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'mfms, idwopt, minv'
			  write(3,20)  mfms, idwopt, minv
			  write(3,10) 'rfms2, rdirec, toler1, toler2'
			  write(3,30)  rfms2, rdirec, toler1, toler2
			  write(3,10) 'tk, thetad, sig2g'
			  write(3,30)  tk, thetad, sig2g
			  write(3,10) ' lmaxph(0:nph)'
			  write(3,20)  (lmaxph(iph),iph=0,nph)
			  !KJ 7-09 Next 2 lines for feff8q
			  write(3,'(a24)') ' the number of decomposition channels'
			  write(3,'(i5)') ldecmx
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine fms_write

		subroutine fms_read
		    integer iph
			open (file=filename, unit=3, status='unknown')
			  read(3,*) ; read(3,*)  mfms, idwopt, minv
			  read(3,*) ; read(3,*)  rfms2, rdirec, toler1, toler2
			  read(3,*) ; read(3,*)  tk, thetad, sig2g
			  read(3,*) ; read(3,*)  (lmaxph(iph),iph=0,nph)
			  !KJ 7-09 Next line for feff8q
			  read(3,*) ; read(3,*) ldecmx
			close(3)
		end subroutine fms_read

		subroutine fms_init
			mfms = 1
			idwopt = -1
			sig2g = 0.d0
			thetad = 0.d0
			tk = 0.d0
			ipr3 = 0
			rprec = 0.e0
		end subroutine fms_init

	end module




!=======================================================================
!     PATHS
!=======================================================================

      module paths_inp
        use ldos_inp
		implicit none
		character(*),parameter,private :: filename='paths.inp'
		integer  mpath, ms, nncrit, nlegxx, ipr4, ica  !KJ added ica 6-06
		!KJ nncrit seems to be bogus input, i.e. not set in rdinp at all ; fully internal to PATH.  Set to 0 and kept here for compatibility.
		real critpw, pcritk, pcrith,  rmax

		contains

		subroutine paths_write
			implicit none
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'mpath, ms, nncrit, nlegxx, ipr4'
			  write(3,20)  mpath, ms, nncrit, nlegxx, ipr4
			  write(3,10) 'critpw, pcritk, pcrith,  rmax, rfms2'
			  write(3,30)  critpw, pcritk, pcrith,  rmax, rfms2
			  write(3,10) 'ica' !KJ 6-06
			  write(3,20)  ica  !KJ 6-06
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine paths_write

		subroutine paths_read
			open (file=filename, unit=3, status='old')
			  read(3,*) ; read(3,*)  mpath, ms, nncrit, nlegxx, ipr4
			  read(3,*) ; read(3,*)  critpw, pcritk, pcrith,  rmax, rfms2
			  read(3,*) ; read(3,*)  ica  !KJ 6-06
			close(3)
		end subroutine paths_read

		subroutine paths_init
			mpath = 1
			ms = 0
			ipr4 = 0
			ica=-1 !KJ 6-06
			critpw = 2.5*1.e0
			pcritk = 0.e0
			pcrith = 0.e0
			rmax = -1 * 1.e0
			nlegxx = 10
			nncrit = 0
		end subroutine paths_init

	end module



!=======================================================================
!     GENFMT
!=======================================================================

      module genfmt_inp
		use global_inp
		implicit none
		character(*),parameter,private :: filename='genfmt.inp'
		integer  mfeff, ipr5, iorder
		logical  wnstar
		double precision critcw

		contains

		subroutine genfmt_write
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'mfeff, ipr5, iorder, critcw, wnstar'
			  write(3,180)  mfeff, ipr5, iorder, critcw, wnstar
		      180   format ( 2i4, i8, f13.5, L5)
			  !KJ 7-09 Next 2 lines for feff8q
			  write(3,'(a24)') ' the number of decomposition channels'
			  write(3,'(i5)') ldecmx
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine genfmt_write

		subroutine genfmt_read
			open (file=filename, unit=3, status='old')
			  read(3,*) ; read(3,*)  mfeff, ipr5, iorder, critcw, wnstar
			  !KJ 7-09 Next line for feff8q
			  read(3,*) ; read(3,*) ldecmx
			close(3)
		end subroutine genfmt_read

		subroutine genfmt_init
			mfeff = 1
			ipr5 = 0
			iorder = 2
			wnstar = .false.
			critcw = 4*1.d0
		end subroutine genfmt_init

	end module



!=======================================================================
!     FF2X
!=======================================================================

      module ff2x_inp
		use global_inp
		use xsph_inp
		use fms_inp
		use genfmt_inp
		implicit none
		character(*),parameter,private :: filename='ff2x.inp'
		integer  mchi, ipr6, mbconv, absolu !KJ added absolu 3-06
		double precision  vrcorr, vicorr, s02, alphat, thetae
		

		contains

		subroutine ff2x_write
			integer i
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'mchi, ispec, idwopt, ipr6, mbconv, absolu, iGammaCH' !KJ added absolu 3-06
			  write(3,20)  mchi, ispec, idwopt, ipr6, mbconv, absolu, iGammaCH !KJ added absolu 3-06
			  write(3,10) 'vrcorr, vicorr, s02, critcw'
			  write(3,30)  vrcorr, vicorr, s02, critcw
			  write(3,10) 'tk, thetad, alphat, thetae, sig2g'
			  write(3,30)  tk, thetad, alphat, thetae, sig2g
			  !KJ 7-09 next 4 lines for feff8q
			  write(3,10) 'momentum transfer'
			  write(3, '(3f13.5)') (xivec(i),i=1,3)
			  write(3,'(a24)') ' the number of decomposition channels'
			  write(3,'(i5)') ldecmx
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine ff2x_write

		subroutine ff2x_read
			integer i
			open (file=filename, unit=3, status='old')
			  read(3,*) ; read(3,*)  mchi, ispec, idwopt, ipr6, mbconv, absolu, iGammaCH !KJ added absolu 3-06
			  read(3,*) ; read(3,*)  vrcorr, vicorr, s02, critcw
			  read(3,*) ; read(3,*)  tk, thetad, alphat, thetae, sig2g
			  read(3,*) ; read(3, *) (xivec(i),i=1,3)
			  read(3,*) ; read(3,*) ldecmx
			close(3)
		end subroutine ff2x_read

		subroutine ff2x_init
			absolu=0  !KJ 3-06 for ABSOLUTE card
			mchi = 1
			ipr6 = 0
			mbconv = 0
			vicorr = 0.d0
			vrcorr = 0.d0
			s02 = 1.d0
			alphat = 0.d0
			thetae = 0.d0
		end subroutine ff2x_init

	end module


!=======================================================================
!     SFCONV
!=======================================================================

      module sfconv_inp
		use global_inp, only : ispec
		use ff2x_inp, only : ipr6
		implicit none
		character(*),parameter,private :: filename='sfconv.inp'
		integer  msfconv, ipse, ipsk
		double precision wsigk, cen
		character(12) cfname

		contains

		subroutine sfconv_write
		!c    sfconv.inp - Josh Kas
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'msfconv, ipse, ipsk'
			  write(3,20)  msfconv, ipse, ipsk
			  write(3,10) 'wsigk, cen'
			  write(3,30) wsigk, cen
			  write(3,10) 'ispec, ipr6'
			  write(3,20)  ispec, ipr6
			  write(3,10) 'cfname'
			  write(3,10) cfname
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine sfconv_write

		subroutine sfconv_read
			open (file=filename, unit=3, status='old')
			read (3,*) ; read (3,*)  msfconv, ipse, ipsk
			read (3,*) ; read (3,*)  wsigk, cen
			read (3,*) ; read (3,*)  ispec, ipr6
			read (3,*) ; read (3,*)  cfname
			close(3)
		end subroutine sfconv_read

		subroutine sfconv_init
			msfconv = 0 ! Josh Kas
			ipse = 0
			ipsk = 0
			wsigk = 0.d0 ! Josh Kas
			cen = 0.d0 ! Josh Kas
			cfname = 'NULL'
		end subroutine sfconv_init

	end module



!=======================================================================
!     EELS
!=======================================================================

      module eels_inp
!		Beam direction in crystal frame of feff.inp (a.u.)
		use global_inp,only: xivec
		implicit none
		character(*),parameter,private :: filename='eels.inp'
!		Beam energy in eV :
		real*8 ebeam
!		Convergence semiangle in rad :
		real*8 aconv
!		Collection semiangle in rad :
		real*8 acoll
!		Integration mesh for q-vectors (radial/angular mesh size)
        integer nqr,nqf
!		Detector position ; angles in rad w.r.t. x and y directions
		real*8 thetax,thetay
!       what kind of q-mesh : uniform (U), logarithmic (L), or one dimensional logarithmic (1)
!       not currently in eels.inp/feff.inp
        character*1      qmodus
!		Parameter for logarithmic mesh - not currently in eels.inp/feff.inp
		real*8 th0
!		Make magic angle plot if magic=1
		integer        magic
!		Evaluate magic angle at this energy point
		real*8        emagic
!		Orientation sensitive?
		integer        aver
!		Do we have cross-terms?
		integer        cross
!		Do we do anything at all?
		integer        eels
!		How many spectra to combine
		integer ipmin,ipmax,ipstep ,nip
!		Where do we take input from :
		integer iinput           
!		Which column? - to be replaced by more advanced switch
		integer spcol
!       Relativistic calculation or not?  Converted into logical inside eels-module.
		integer relat

		contains

		subroutine eels_write
			open (file=filename, unit=3, status='unknown')
			  write(3,10) 'calculate ELNES?'
			  write(3,20) eels
			  write(3,10) 'average? relativistic? cross-terms? Which input?'
			  write(3,20) aver, relat, cross, iinput, spcol
			  write(3,10) 'polarizations to be used ; min step max'
			  write(3,20) ipmin,ipstep,ipmax
			  write(3,10) 'beam energy in eV'
			  write(3,30) ebeam
			  write(3,10) 'beam direction in arbitrary units'
			  write(3,30) xivec
			  write(3,10) 'collection and convergence semiangle in rad'
			  write(3,30) acoll,aconv
			  write(3,10) 'qmesh - radial and angular grid size'
			  write(3,20) nqr,nqf
			  write(3,10) 'detector positions - two angles in rad'
			  write(3,30) thetax,thetay
			  write(3,10) 'calculate magic angle if magic=1'
			  write(3,20) magic
			  write(3,10) 'energy for magic angle - eV above threshold'
			  write(3,30) emagic
			close(3)
		! standard formats for string, integers and real numbers
	  10  format(a)
	  20  format (20i4)
	  30  format (9f13.5)
		end subroutine eels_write

		subroutine eels_read
			open (file=filename, unit=3, status='old',err=100)
			read(3,*) ; read(3,*,end=100,err=100) eels
			read(3,*) ; read(3,*,err=209) aver, relat, cross, iinput,spcol ; goto 210
			209   iinput=1;spcol=4;relat=1;cross=1;aver=0  !restore defaults - this construction for older files.
			210 read(3,*) ; read(3,*) ipmin,ipstep,ipmax  !KJ this un-Kevin-like construction for older files ...
			nip=1+((ipmax-ipmin)/ipstep)
			read(3,*) ; read(3,*) ebeam
			read(3,*) ; read(3,*) xivec
			read(3,*) ; read(3,*) acoll,aconv
			read(3,*) ; read(3,*) nqr,nqf
			read(3,*) ; read(3,*) thetax,thetay
			read(3,*) ; read(3,*) magic
			read(3,*) ; read(3,*) emagic
			close(3)
			return
100			eels = 0  ; ipmin=1 ; ipmax=1 ; ipstep=1 ! no eels.inp -> don't do eels
            return
		end subroutine eels_read


        subroutine eels_init !default values for everything (except xivec)
		  ebeam=0.d0
		  aconv=0.d0
		  acoll=0.d0
		  nqr=0
		  nqf=0
		  magic=0
		  emagic=0.d0
		  eels=0
		  relat=1
		  cross=1
		  aver=0
		  thetax=0.d0
		  thetay=0.d0
		  ipmin=1
		  ipmax=1
		  nip=1
		  ipstep=1
          iinput=1  ! xmu.dat - files from ff2x
          spcol=4   ! xmu.dat - use spectrum mu(omega)
          qmodus='U'  !  U for uniform grid 
          th0=0.d0
		end subroutine eels_init

	end module



!=======================================================================
!     COMPTON
!=======================================================================


    module compton_inp
      implicit none
      character(*),parameter,private :: filename='compton.inp'

      ! spatial and momentum grid parameters
      integer :: ns, nphi, nz, nzp, npq
      real :: smax, phimax, zmax, zpmax, pqmax

      ! flags
      logical :: do_compton, do_rhozzp
      logical :: force_jzzp
	  integer run_compton_module

      ! apodization function type
      integer :: window
      real :: window_cutoff

      real :: temperature
      logical ::  set_chemical_potential
      real :: chemical_potential

      integer, parameter :: WINDOW_STEP = 0, WINDOW_HANNING = 1
    contains
      subroutine compton_write
	    if (do_compton .or. do_rhozzp) then
		   run_compton_module=1
		else
		   run_compton_module=0
		endif
        open (file=filename, unit=3, status='unknown')
		  write(3,10) 'run compton module?'
		  write(3,*)  run_compton_module 
          write(3,10) 'pqmax, npq'
          write(3,*) pqmax, npq
          write(3,10) 'ns, nphi, nz, nzp'
          write(3,20) ns, nphi, nz, nzp
          write(3,10) 'smax, phimax, zmax, zpmax'
          write(3,30) smax, phimax, zmax, zpmax
          write(3,10) 'jpq? rhozzp? force_recalc_jzzp?'
          write(3,*) do_compton, do_rhozzp, force_jzzp
          write(3,10) 'window_type (0=Step, 1=Hann), window_cutoff'
          write(3,*) window, window_cutoff
          write(3,10) 'temperature (in eV)'
          write(3,30) temperature
          write(3,10) 'set_chemical_potential? chemical_potential(eV)'
          write(3,*) set_chemical_potential, chemical_potential
        close(3)
		! standard formats for string, integers, real numbers
    10  format(a)
    20  format (20i4)
    30  format (9f13.5)
      end subroutine compton_write

      subroutine compton_read
        open (file=filename, unit=3, status='old',err=100)
		  read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) run_compton_module
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) pqmax, npq
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) ns, nphi, nz, nzp
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) smax, phimax, zmax, zpmax
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) do_compton, do_rhozzp, force_jzzp
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) window, window_cutoff
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) temperature
          read(3,*,end=100,err=100) ; read(3,*,end=100,err=100) set_chemical_potential, chemical_potential
        close(3)
        return
        100			run_compton_module=0  ! no compton.inp -> don't do compton
        return
      end subroutine compton_read

      subroutine compton_init
        real, parameter :: pi  = 3.1415926535897932384626433832795
        ns   = 32
        nphi = 32
        nz   = 32
        nzp  = 144

        smax   = 0
        phimax = 2*pi
        zmax   = 0
        zpmax  = 10.0

        npq   = 1000
        pqmax = 5.0

        do_compton     = .false.
        do_rhozzp  = .false.
        force_jzzp = .false.
		run_compton_module=0

        window = WINDOW_HANNING
        window_cutoff = 0

        temperature = 0.0
        set_chemical_potential = .false.
        chemical_potential = 0
      end subroutine compton_init
    end module

! Kevin Jorissen 2012.  Purpose: to pass exit codes to  an external program, e.g. the JFEFF Java GUI which launches FEFF9 modules and must be able to figure out if they succeed before launching the next module.
! There is no really reliable way to set exit codes in Fortran (compiler/platform dependencies; exit codes are only included in very latest Fortran standards (2008? 2010?).
! Therefore, we copy the WIEN2k approach.  Set error file in working directory at program launch.  Wipe it on successful termination.  The GUI can then check for the presence of a non-zero-size file:
! If such a file exists, the program did not exit cleanly, signifying a crash.  This approach is robust and does not depend on any Fortran programming to catch runtime exceptiosn, memory allocation problems, ...
! The downside is that the file will not contain much useful information.  However any runtime information will still be printed to the screen.

! There is already some error handling code present in FEFF, introduced by Josh; presumably only used in a few of the routines he contributed?  In any case, it is not set up to output to file rather than stdout/err,
! and I don't want to mess with it.  The simple code below is good enough for me.

module errorfile

implicit none
character*11,private :: ErrorFileName='.feff.error'
integer,private :: lun = 77


contains

subroutine OpenErrorfileAtLaunch(ModuleName)
   ! Open the errorfile and set a default message.  Call at the start of a module.
   character*(*),intent(in) :: ModuleName
   character*500 :: ErrorMessage
   ErrorMessage='Starting FEFF9 module '//ModuleName//'.  If this message is still here after the module finishes running, it must have crashed.  The content of this file is wiped on successful termination.'
   call SetErrorfileMessage(ErrorMessage)
   return
end subroutine OpenErrorfileAtLaunch


subroutine WipeErrorfileAtFinish
  !Overwrite the error file with an empty, 0-byte file.  Call at the regular termination of a module.
  open(lun,file=ErrorFileName,status='replace',err=1000)
  close(lun)
  return
  1000 stop 'Unable to wipe errorfile in SetErrorfileMessage.  How ironic.'
end subroutine WipeErrorfileAtFinish



subroutine SetErrorfileMessage(ErrorMessage)
   !Write a user(programmer)-specified error message to the errorfile.  Useful for diagnostic purposes.
   character*(*),intent(in) :: ErrorMessage
   open(lun,file=ErrorFileName,status='unknown',err=1000)
   write(lun,*) ErrorMessage
   close(lun)
   return
   1000 stop 'Unable to open errorfile in SetErrorfileMessage'
end subroutine SetErrorfileMessage



end module errorfile

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: m_par.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      module par

	  implicit none
	  integer par_type, this_process, numprocs, my_rank
      logical master, worker, parallel_run
      real*8 wall_comm, time_comm

      end module

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: rdinp.f90,v $:
! $Revision: 1.78 $
! $Author: jorissen $
! $Date: 2012/10/23 17:13:13 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     sub-program exchange point
      program rdinp 
!     subroutine rdinp (nabs,nss,ceels)

!    reads 'feff.inp' file and writes several files in special format
!    ready for the use by other modules: geom.dat, global.dat,
!    mod1.inp, mod2.inp, mod3.inp mod4.inp mod5.inp mod6.inp ldos.inp .
!    The subroutine output 'nabs' is needed for configurational average
!    The rest of output, passed to wrtall via modules (COMMON/m_inpmodules.f90).

!     coded s. zabinski 1994
!     last modified by a.l.ankudinov march 2001  for new i/o structure
!     introduced k-space and eels ; introduced modules, merged feffq ; improved dynamic allocation - Kevin Jorissen 7-09 


!KJ restructured input data 7-09 :
      use par
	  use constants
      use geometry_inp
	  use global_inp
	  use reciprocal_inp
	  use potential_inp
	  use ldos_inp
      use opcons_inp
	  use xsph_inp
	  use fms_inp
	  use paths_inp
	  use genfmt_inp
	  use ff2x_inp
	  use sfconv_inp
	  use eels_inp
      use compton_inp
      use dimsmod
	  use screen_inp,only:screen_inp_parse
	  use errorfile
      !use struct,only: nphstr => nph	  

!      implicit double precision (a-h, o-z)
      implicit none
!!! EXPANDING INCLUDE statement: ./HEADERS/vers.h 
      character*12 vfeff
      CHARACTER(300) revision
!                       123456789012  
      PARAMETER (vfeff='FEFF 9.6   ')
      PARAMETER (revision='Revision 1')

      ! 9.00 prepared by Joshi and Josh from feff86
      ! 9.01 JP starts dynamic allocation, KJ merges and cleans up
      ! 9.02 KJ integrates feff8q, revision of rdinp and modules, etc.
      ! 9.03 JK a few bug fixes.
      ! 9.05 JK: first official release of feff9
      ! 9.1  KJ decides it's time to move on to the next digit.
      ! 9.5  KJ: big clean-up, integration with JFEFF
      ! 9.6  KJ: First real public release since 9.1
!!! END OF : ./HEADERS/vers.h 

!     Single scattering path to go with Overlap information
      integer, parameter :: nssx = 16
      integer indss(nssx), iphss(nssx)
      real*8 degss(nssx), rss(nssx)

!     Local stuff
!      integer,parameter :: nwordx = 20
      integer,parameter :: nbr=100  !KJ 12-2011 max number of SCF iterations.  Changed from 30 to 100.
      integer,parameter :: big = 1.0e5
      character*512 slog
      character*150  line
      character*120 words(nwordx)
      character*20 symfil !KJ file that contains symmetry for k-mesh 11-06
      character*12 tmpstr
	  character*6 str6 ! dummy
	  character*3 str3
      integer ltit(nheadx),iatph(0:nphx),iss,iatabs,nttl,iabs,nat
      integer icnt,ios,iatom,ifolp,iovrlp,lxnat,nss,mode,jinit,nwords,itok,nph_read
      integer icoord,i,j,k,iph,iovr,ltmp,iatrd,i1,i2,i3,j1,j2,j3,indexabs,iat,icount,iq,iqq
      logical nogeom,userchl
      logical ceels  !KJ for monolithic version 5-6
      integer mpathold !KJ to fix OVERLAP card 7-06
      real*8 sss(3),alatt,xxx(3),distance(nattx),scalelattice,mindist,qvec(3),dummy,dummy2,userChLifetime
	  real*8 folpx,rmult,s02h,tmp,rdims,ratmin,ratmax,xinorm,xnat,cosmdff_dum,magnifier,ratomslist
	  real*8 shift(3,3)
	  integer nshift,lattice_factor
      integer nclusxuserlimit,lxuserlimit !KJ 7-09
	  logical cards_set(100) !KJ needs be big enough to have a field for each programmed card 7-09 for consistency checker
	  logical cifread !KJ 10-2011 Take crystal structure from .cif file
	  character*120 cifname !KJ 10-2011 Name of .cif file
	  integer cif_equivalence !KJ 1-2012 for making potential types from .cif file
!	  integer nq !KJ now in global_inp
	  logical,parameter :: enforce_alexis_exchange_policy = .false. !KJ 11-2010 - I don't know why Aleksi had it in the first place, just keeping this as precaution
! Added by Fer
! Needed for DMDW
      logical            :: Use_DMDW = .FALSE.
      integer            :: DMDW_Order, DMDW_Type, DMDW_Route
      integer            :: iiAtom, jjAtom
      real               :: mxDij2, Dij2
      character(len=256) :: dym_File

!     Functions :
	  integer,external :: itoken,istrln
	  real*8,external :: dist
       integer iTmp

   10 format (a)
   20 format (bn, i15)
   30 format (bn, f15.0)

      call par_begin
      if (worker) go to 400
	  call OpenErrorfileAtLaunch('rdinp')	

!     open the log file, unit 11.  See subroutine wlog.
      open (unit=11, file='log.dat', status='unknown', iostat=ios)
      call chopen (ios, 'log.dat', 'feff')

      tmpstr = vfeff
      call triml (tmpstr)
      call wlog(' ' // tmpstr)
      ! Josh adding revision number to feff output.
      !call wlog(' ' // revision)

!     initialize all things to be passed
      call iniall

! KJ this one left over from iniall, doesn't seem to belong anywhere!
      nat = 0

!     initialize local staff 
      iatom = 0
      icoord = 3 !KJ default : SPRKKR coordinates
      ifolp = 0
      iovrlp = 0
      lxnat = 0
      folpx = 1.15d0
      nogeom = .false.
      rclabs = big
      rmult = 1.0d0
      s02h = 1.0d0
      nss = 0
      nclusxuserlimit = -1 !KJ -1 means undef
      lxuserlimit = -1 !KJ
      indss(:) = 0
      iphss(:) = 0
      degss(:) = 0
      rss(:) = 0
      iatph(:) = 0
      symfil='                    '  !KJ 11-06
	  cards_set(:)=.false. !KJ 7-09
      userchl=.false. !KJ 6-10 get ch lifetime from setgam
      cifread=.false.
	  cif_equivalence=1 !KJ 1-12 use default scheme for setting potentials

!     tokens  0 if not a token
!             1 if ATOM (ATOMS)
!             2 if HOLE
!             3 if OVER (OVERLAP)
!             4 if CONT (CONTROL)
!             5 if EXCH (EXCHANGE)
!             6 if ION
!             7 if TITL (TITLE)
!             8 if FOLP
!             9 if RPATH or RMAX
!            10 if DEBY (DEBYE)
!            11 if RMUL (RMULTIPLIER)
!            12 if SS
!            13 if PRIN (PRINT)
!            14 if POTE (POTENTIALS)
!            15 if NLEG
!            16 if CRIT (CRITERIA)
!            17 if NOGEOM
!            18 if IORDER
!            19 if PCRI (PCRITERIA)
!            20 if SIG2
!            21 if XANE (XANES)
!            22 if CORR (CORRECTIONS)
!            23 if AFOL (AFOLP)
!            24 if EXAF (EXAFS)
!            25 if POLA (POLARIZATION)
!            26 if ELLI (ELLIPTICITY) 
!            27 if RGRI (RGRID)
!            28 if RPHA (RPHASES), real phase shifts
!            29 if NSTA (NSTAR), n* for co-linear polarization
!            30 if NOHO (NOHOLE), use no hole for potentials
!            31 if SIG3 third and first cumulants for ss paths
!            32 if JUMP (JUMPRM), remove jumps of potential   
!            33 if MBCO (MBCONV), do convolution with exitation spectrum
!            34 if SPIN do calculation for spin-up(down) photoelectron  
!            35 if EDGE to specify edge by name
!            36 if SCF  do self-consistency loop
!            37 if FMS  use FMS for cluster of the size rfms
!            38 if LDOS print out l-dos for specified energy range
!            39 if INTE how to find interstitial parameters
!            40 if CFAV to do configuration average
!            41 if S02  to specify S_0^2
!            45 if RSIG (RSIGMA), real self-energy 
!            46 if XNCD natural dichroism
!            47 if MULT for quadrupolar etc. transitions
!            48 if UNFR unfreeze f-electrons
!            49 if TDLDA use TDLDA background
!            50 if PMBSE use BSE for background
!            51 if PLASMON       - Added by Josh Kas
!                                - PLASMON
!                                - With this card set, ffmod2 will read exc.dat and
!                                - use a multiple pole self energy
!            52 if SFCO (SFCONV) compute spectral function from response function
!                  and convolve output.
!            53 if SELF print on shell self energy as a function of E.
!            54 if SFSE print off shell self energy and spectral function.
!            55 if RCONV print running convolution with spectral function.
!            56 if ELNE calculate ELNES  !KJ 1-06
!            57 if EXEL calculate EXELFS !KJ 1-06
!            58 if MAGI plot magic angle !KJ 1-06
!            59 if ABSO don't normalize spectrum !KJ 3-06
!            60 if SYMM fix value of icase in PATH module !KJ 6-06
!            61 if REAL work in real space  !KJ 8/06
!            62 if RECIPROCAL work in reciprocal space  !KJ 8/06
!            63 if SGROUP
!            74 if EXTPOT use external mt potentials defined in extpot.aip
!            77 if DIMS specify lx and nclusx for dynamical allocation
!            78 if NRIXS
!            79 if LJMAX convergence parameter for NRIXS
!            80 if LDEC output parameter for NRIXS
!            81 if SETE
!            82 if EPS0 specify dielectric constant to correct exc.dat for MPSE
!            83 if OPCONS make feff create loss.dat from database.
!            84 if NUMDENS use with OPCONS card to specify number densities
!            85 if PREP
!            86 if EGAP
!            87 if CHWIDTH set core hole lifetime manually !KJ 6/2010
!            88 if MDFF calculate mdff - hidden secret option !KJ 11/2010
!            89 if RESTART get starting potentials from pot.inp instead of atomic overlap !KJ 12-2010
!            90 if CONFIG use non-default electronic configuration for some atoms !KJ 12-2010
!            -1 if END  (end)
!     mode flag  0 ready to read a keyword card
!                1 reading atom positions
!                2 reading overlap instructions for unique pot
!                3 reading unique potential definitions
!                4 reading EELS input  !KJ


!   call to rdline, which will:
!    1. read from feff.inp if found, otherwise will stop and complain
!       (support for reading from standard input would be easy to add)
!    2. handles line processing tasks like 
!         = ignoring comment lines and blank lines
!         = tab removal
!    3. allows 'include' files in input file
!    4. for initial call, set jinit = -1, line = input_file_name
!
      mode  = 0
      jinit = -1
      line  = 'feff.inp'
  200 continue 
         call rdline(jinit,line)
         if (line .eq. 'read_line_end')    line='END'
         if (line .eq. 'read_line_error')  line='END'
         words=' '
         nwords = nwordx
		 
         call bwords (line, nwords, words)
         itok = itoken (words(1),'feff.inp')
		 if (itok.gt.0) cards_set(itok)=.true.  !KJ 7-09
		 
		 !write(*,*) nwords,words(1:nwords)

!        process the card using current mode
  210    continue

         if (mode .eq. 0)  then
            if (itok .eq. 1)  then
!              ATOM
!              Following lines are atom postions, one per line
               mode = 1
               iatom  = iatom  +1
            elseif (itok .eq. 2)  then
!              HOLE     1  1.0
!                   holecode s02
               read(words(2),20,err=900)  ihole
               if (nwords.gt.2) read(words(3),30,err=900)  s02h
               mode = 0
            elseif (itok .eq. 3)  then
!              OVERLAP iph
!                  iph  n  r
               read(words(2),20,err=900)  iph
               call phstop(iph,line)
               mode = 2
               iovrlp = iovrlp +1
            elseif (itok .eq. 4)  then
!              CONTROL  mphase, mpath, mfeff, mchi
!               0 - do not run modules, 1 - run module
               if (nwords.eq.5) then
!                 feff7 input file
                  read(words(2),20,err=900)  mpot
                  mphase = mpot
                  mfms = mpot
                  read(words(3),20,err=900)  mpath
                  read(words(4),20,err=900)  mfeff
                  read(words(5),20,err=900)  mchi
               else
!                 feff8 input file
                  read(words(2),20,err=900)  mpot
                  read(words(3),20,err=900)  mphase
                  read(words(4),20,err=900)  mfms
                  read(words(5),20,err=900)  mpath
                  read(words(6),20,err=900)  mfeff
                  read(words(7),20,err=900)  mchi
               endif
               mode = 0
            elseif (itok .eq. 5)  then
!              EXCHANGE  ixc  vr0  vi0 (ixc0)
!              ixc=0  Hedin-Lunqvist + const real & imag part
!              ixc=1  Dirac-Hara + const real & imag part
!              ixc=2  ground state + const real & imag part
!              ixc=3  Dirac-Hara + HL imag part + const real & imag part
!              ixc=5  partially nonlocal: Dirac-Fock for core + HL for
!                     valence electrons, + const real & imag part
!              ixc=10 same as ixc=0 with broadened plasmon HL selfenergy
!              ixc=13 same as ixc=3 with broadened plasmon HL selfenergy
!              ixc=15 same as ixc=5 with broadened plasmon HL selfenergy
!              vr0 is const imag part of potential
!              vi0 is const imag part of potential
!              Default is HL. (ixc=0, vr0=0, vi0=0, ixc0 = 2)
               vr0=0.0
               vi0=0.0
               read(words(2),20,err=900)  ixc
!              if (nwords.ge.3) (read(words(3),30,err=900)  vr0
                read(words(3),30,err=900)  vr0
!              if (nwords.ge.4) read(words(4),30,err=900)  vi0
                read(words(4),30,err=900)  vi0
               if (nwords .gt. 4) read(words(5),20,err=900)  ixc0
               mode = 0
            elseif (itok .eq. 6)  then
!              ION  iph xion(iph)
               read(words(2),20,err=900)  iph
               call phstop(iph,line)
               read(words(3),30,err=900)  xion(iph)
               mode = 0
            elseif (itok .eq. 7)  then
!              TITLE title...
               ntitle = ntitle + 1
               if (ntitle .le. nheadx)  then
                  title(ntitle) = line(6:)
                  call triml (title(ntitle))
               else
                  call wlog(' Too many title lines, title ignored')
                  call wlog(' ' // line(1:71))
               endif
               mode = 0
            elseif (itok .eq. 8)  then
!              FOLP iph folp (overlap factor, default 1)
               ifolp = 1
               read(words(2),20,err=900)  iph
               call phstop(iph,line)
               read(words(3),30,err=900)  folp(iph)
               mode = 0
            elseif (itok .eq. 9)  then
!              RPATH rmax (max r for ss and pathfinder)
               read(words(2),30,err=900)  rmax
            elseif (itok .eq. 10)  then
!              DEBYE  temp debye-temp ( idwopt )
!                1     2        3          4
!                          + other if idwopt = 4:
!                            dym_File  DMDW_Order DMDW_Type DMDW_Route
!                                5          6         7         8
!                   temps in kelvin
!                   idwopt = 0 use CD model
!                   idwopt = 1 use EM method
!                   idwopt = 2 use RM method
!                   idwopt = 3 use CL method !KJ 7/06
!                   idwopt = 4 use sig2.dat file !JK (via FDV)
!                   idwopt = 5 use Dynamical Matrix method !FDV
!                   idwopt = -1,-2,... don't calculate DW factors
!                   These add to any sig2 from SIG2 card or files.dat
               read(words(2),30,err=900)  tk
               read(words(3),30,err=900)  thetad
               idwopt=0 
               if (nwords.gt.3) then
                 read(words(4),20,err=900)  idwopt

! Added by Fer
! Get the options for the Dynamical Matrix Calculation
                 if (idwopt .eq. 5) then
! Activate the DMDW stuff
                   Use_DMDW = .true.
                   dym_File = "feff.dym"
                   if (nwords .gt. 4) then
!   Get the filename in which to find the dynamical matrix
                     read(words(5),10,err=900) dym_File
                   end if
!   Get the Lanczos recursion order
                   DMDW_Order = 2
                   if (nwords .gt. 5) then
                     read(words(6),20,err=900) DMDW_Order
                   end if
!   Get the type of DMDW calculation to do
                   DMDW_Type = 0
                   if (nwords .gt. 6) then
                     read(words(7),20,err=900) DMDW_Type
                   end if
!   Get the route to determine what to calculate
                   DMDW_Route = 0
                   if (nwords .gt. 7) then
                     read(words(8),20,err=900) DMDW_Route
                   end if
                   
                 end if
                 if (idwopt.gt.5) then   !KJ 7/06 changed 2 to 3. 
                                         !Josh - Changed 3 to 4
                                         !FDV - Changed from 4 to 5
                    write(slog,'(a,i5,2x,a)')  ' Option idwopt=',idwopt,'is not available.'
                    call wlog(slog)
                    write(slog,'(a)')   '...setting idwopt=2 to use RM.' 
                    call wlog(slog)
                    idwopt = 2
                 endif
               endif
               mode = 0
            elseif (itok .eq. 11)  then
!              RMULTIPLIER  rmult
!              Multiples atom coord, rss, overlap and rmax distances by
!              rmult (default 1).  DOES NOT modify sig2g
               read(words(2),30,err=900)  rmult
               mode = 0
            elseif (itok .eq. 12)  then
!              SS index ipot deg rss
               nss = nss + 1
               if (nss .gt. nssx)  then
                  write(slog,'(a,i8)')                                  &
     &               ' Too many ss paths requested, max is ', nssx
                  call wlog(slog)
                  call par_stop('RDINP')
               endif
               read(words(2),20,err=900)  indss(nss)
               read(words(3),20,err=900)  iphss(nss)
               read(words(4),30,err=900)  degss(nss)
               read(words(5),30,err=900)  rss(nss)
               mode = 0
            elseif (itok .eq. 13)  then
!              PRINT  ipr1  ipr2  ipr3  ipr4 ipr5 ipr6
!              print flags for various modules
!              ipr1 potph  0 pot.bin only
!                          1 add misc.dat
!                          2 add pot.dat
!                          5 add atom.dat
!                          6 add central atom dirac stuff
!                          7 stop after doing central atom dirac stuff
!              ipr2 xsph   0 phase.bin only
!                          2 add  phase.dat
!                          3 add  emesh.dat
!              ipr3 fmstot  currently is dummy
!              ipr4 pathfinder  0 paths.dat only
!                               1 add crit.dat
!                               2 keep geom.dat
!                               3 add fbeta files
!                               5 special magic code, crit&geom only
!                                 not paths.dat.  Use for path studies
!              ipr5 genfmt 0 files.dat, feff.dats that pass 2/3 of
!                            curved wave importance ratio
!                          1 keep all feff.dats
!              ipr6 ff2chi 0 chi.dat
!                          1 add sig2.dat with debye waller factors
!                          2 add chipnnnn.dat for each path
!                          3 add feffnnnn.dat for each path, and
!                            do not add chipnnnn.dat for each path
!                          4 add both feffnnnn.dat and chipnnnn.dat
!                            for each path
               if (nwords.eq.5) then
!                 feff7 input file
                  read(words(2),20,err=900)  ipr1
                  ipr2 = ipr1
                  ipr3 = ipr1
                  read(words(3),20,err=900)  ipr4
                  read(words(4),20,err=900)  ipr5
                  read(words(5),20,err=900)  ipr6
               else
!                 feff8 input file
                  read(words(2),20,err=900)  ipr1
                  read(words(3),20,err=900)  ipr2
                  read(words(4),20,err=900)  ipr3
                  read(words(5),20,err=900)  ipr4
                  read(words(6),20,err=900)  ipr5
                  read(words(7),20,err=900)  ipr6
               endif
               mode = 0
            elseif (itok .eq. 14)  then
!              POTENTIALS
!              Following lines are unique potential defs, 1 per line
               mode = 3
            elseif (itok .eq. 15)  then
!              NLEG nlegmax (for pathfinder)
               read(words(2),20,err=900)  nlegxx
               mode = 0
            elseif (itok .eq. 16)  then
!              CRIT critcw critpw
               read(words(2),30,err=900)  critcw
               read(words(3),30,err=900)  critpw
               mode = 0
            elseif (itok .eq. 17)  then
!              NOGEOM (do not write geom.dat) (disabled)
               nogeom = .true.
               mode = 0
            elseif (itok .eq. 18)  then
!              IORDER  iorder (used in genfmt, see setlam for meaning)
               read(words(2),20,err=900)  iorder
               mode = 0
            elseif (itok .eq. 19)  then
!              PCRIT  pcritk pcrith
!                     (keep and heap criteria for pathfinder)
               read(words(2),30,err=900)  pcritk
               read(words(3),30,err=900)  pcrith
               mode = 0
            elseif (itok .eq. 20)  then
!              SIG2  sig2g   global sig2 used by ff2chi, summed with
!              correlated debye model if DEBYE card used, and with
!              sig2 from files.dat if non-zero.
!              Units are Ang**2
               read(words(2),30,err=900)  sig2g
               mode = 0
            elseif (itok .eq. 21)  then
!              XANES ( xkmax  xkstep vixan)
               if (ixc0.lt.0) ixc0 = 2
!              Use extended k range for xanes
               ispec = 1
!              to avoid problems with debye waller factors below the
!              edge, always use complex p for debye waller
!              set the energy grid. xkstep - step in k to use for high
!              energies up to kmax. Near the Fermi level the energy
!              grid is regular in energy with step=vixan
!              the default value is vixan=gamma_ch/2+vi
               if (nwords.gt.1) read(words(2),30,err=900)  xkmax 
               if (nwords.gt.2) read(words(3),30,err=900)  xkstep
               if (nwords.gt.3) read(words(4),30,err=900)  vixan

!              sanity checks
               if (xkstep.lt.0.01) xkstep = 0.01d0
               if (xkstep.gt.2.0) xkstep = 0.5d0
               if (abs(xkmax).lt.2) xkmax = 2.d0 !KJ 7-09 added abs for feff8q
               if (abs(xkmax).gt.200) xkmax = 200.d0 !KJ 7-09 added abs for feff8q
               mode = 0
            elseif (itok .eq. 22)  then
!              CORRECTIONS  e0-shift, lambda correction
!              e0 shift is in eV, edge will be edge-e0
!              lambda corr is a const imag energy in eV
!              e0 and lambda corr same as vr0 and vi0 in EXCH card
               read(words(2),30,err=900)  vrcorr
               read(words(3),30,err=900)  vicorr
               mode = 0
            elseif (itok .eq. 23)  then
!              AFOLP use generalized automatic folp
               folpx = 1.15
               if (nwords.ge.2) read(words(2),30,err=900)  folpx
               mode =0
            elseif (itok .eq. 24)  then
!              EXAFS  xkmax for energy grid
               read(words(2),30,err=900)  xkmax
               mode = 0
            elseif (itok .eq. 25)  then
!              POLARIZATION  X Y Z
               ipol = 1
!              run linear polarization code 
               read(words(2),30,err=900)  evec(1)
               read(words(3),30,err=900)  evec(2)
               read(words(4),30,err=900)  evec(3)
               mode = 0
            elseif (itok .eq. 26)  then
!              ELLIPTICITY  E incident direction
               read(words(2),30,err=900)  elpty
               read(words(3),30,err=900)  xivec(1)
               read(words(4),30,err=900)  xivec(2)
               read(words(5),30,err=900)  xivec(3)
               mode = 0
            elseif (itok .eq. 27)  then
!              RGRID  rgrd
!              rgrd will be dpas, default is 0.03 in feff7
               read(words(2),30,err=900)  rgrd
               write(slog,'(a,1pe13.5)') ' RGRID, rgrd; ', rgrd
               call wlog(slog)
               i = 1 + int (12.5d0 / rgrd)
               if (mod(i,2) .eq. 0) i = i + 1
               if (i.gt.nrptx) then
                 write(slog,'(a,i6)')                                   &
     &           ' FATAL error in RGRID: increase in m_dimsmod.f90 nrptx to', i
                 call wlog(slog)
                 call par_stop(' ')
               endif
               mode = 0
            elseif (itok .eq. 28)  then
!              RPHASES (real phase shifts only)
               call wlog(' Real phase shifts only will be used.  ' //   &
     &                   'FEFF results will be unreliable.')
               lreal = 2
               mode = 0
            elseif (itok .eq. 29)  then
!              NSTAR, write out n* for colinear polarization
               wnstar = .true.
               mode = 0
            elseif (itok .eq. 30)  then
!              NOHOLE
               if (nohole.lt.0) then
                  nohole = 0
                  if (nwords.ge.2) read(words(2),20,err=900)  nohole
               end if
            elseif (itok .eq. 31)  then
!              SIG3 alphat  thetae   first and third cumulants for ss paths
               read(words(2),30,err=900)  alphat
               if (nwords.ge.3) read(words(3),20,err=900)  thetae
               write(slog,'(a,1pe13.5)') ' SIG3, alphat ; ', alphat
               call wlog(slog)
               mode = 0
            elseif (itok .eq. 32)  then
!              JUMPRM remove potential jumps at muffin tin radii
               jumprm = 1
            elseif (itok .eq. 33)  then
!              MBCONV do many body convolution with excitation spectrum
               mbconv = 1
            elseif (itok .eq. 34)  then
!              SPIN  specifies spin direction on central atom 
               read(words(2),20,err=900)  ispin 
!              set default spin along z axis
               if (ispin.ne.0) spvec(3) = 1.d0
               if (nwords.gt.2) read(words(3),30,err=900)  spvec(1)
               if (nwords.gt.3) read(words(4),30,err=900)  spvec(2)
               if (nwords.gt.4) read(words(5),30,err=900)  spvec(3)
            elseif (itok .eq. 35)  then
!              EDGE     L3 
!                   holecode
               call setedg (words(2), ihole)
               mode = 0
            elseif (itok .eq. 36)  then
!              SCF    rfms [ lfms nscmt  ca1 nmix  ecv icoul]
!              number of cycles, mode of calculating coulomb potential,
!              convergence accelerator
               nscmt = nbr
               ca1 = 0.2d0
               read(words(2),30,err=900)  rfms1
               if (nwords.gt.2) read(words(3),20,err=900)  lfms1
               if (nwords.gt.3) read(words(4),20,err=900)  nscmt
               if (nwords.gt.4) read(words(5),30,err=900)  ca1
               if (nwords.gt.5) read(words(6),20,err=900)  nmix
               if (nwords.gt.6) read(words(7),30,err=900)  ecv
               if (nwords.gt.7) read(words(8),20,err=900)  icoul
               if (nscmt.le.0 .or. nscmt.gt.nbr) then  !KJ 12-2011 I added the diagnostic message - the user may want to know, y'know?
			      call wlog('Invalid number of SCF iterations specified.  Reset to hardwired limit.')
				  nscmt = nbr
			   endif
			   if (nwords.gt.5 .and. nmix.gt.30) then !KJ 12-2011 added this so it's done transparently to the user.
			      call wlog('Number of Broyden SCF cycles exceeds hardwired maximum of 30; will be reset to 30.')  !KJ This is, I think, vaguely and messily enforced in broydn.f90.  I hate old-school FEFF programming style ...
                  nmix=30
			   endif
		       if (lfms1.gt.0) lfms1 = 1
!              sanity checks for ca1
               if (ca1.lt.0) ca1 =0
               if (ca1.gt.0.5) then
                 call wlog(' Reduce convergence factors in SCF ')
                 call par_stop                                          &
     &            (' Cannot run with specified ca1 in SCF card.')
               endif
               if (ecv.ge.0) ecv = -40.0
               if (nmix.le.0) nmix=1
               if (nmix.gt.30) nmix=30
            elseif (itok .eq. 37)  then
!              FMS   rfms2  (lfms2 minv toler1 toler2 rdirec)
!              radius of the cluster to do FMS
               read(words(2),30,err=900)  rfms2
               if (nwords.gt.2) read(words(3),20,err=900)  lfms2
               if (nwords.gt.3) read(words(4),20,err=900)  minv
               if (nwords.gt.4) read(words(5),30,err=900)  toler1
               if (nwords.gt.5) read(words(6),30,err=900)  toler2
               if (nwords.gt.6) read(words(7),30,err=900)  rdirec
               if (rdirec .gt. 2*rfms2 .or. rdirec.lt.0) rdirec=2*rfms2
               if (lfms2.gt.0) lfms2 = 1
            elseif (itok .eq. 38)  then
!              LDOS  emin  emax  eimag  neldos
               mldos = 1
               read(words(2),30,err=900)  emin
               read(words(3),30,err=900)  emax
               read(words(4),30,err=900)  eimag
               if (nwords.gt.4) read(words(5),20,err=900)  neldos
               if (neldos.gt.nex) then
                 write (slog, "(a,i4,a)") "Warning - the number of energy points specified in the LDOS card is larger than the hardcoded maximum value (nex = ", nex, "). The maximum value will be used instead."
                 call wlog(slog)
                 neldos = nex
               end if
            elseif (itok .eq. 39)  then
!              INTERSTITIAL  inters  totvol
!              inters = 1 local V_int (around central atom)
!              inters = 0 extended V_int (average over all atoms)
!              more obscure options described in manual
               read(words(2),20,err=900)  inters
               if (nwords.ge.3) read(words(3),30,err=900)  totvol
            elseif (itok .eq. 40) then
!              CFAV  iphabs nabs rclabs
               read(words(2),20,err=900)  iphabs
               read(words(3),20,err=900)  nabs
               read(words(4),30,err=900)  rclabs
               if (rclabs.lt.0.5) rclabs=big
               mode = 0
            elseif (itok .eq. 41) then
!              S02  s02
               read(words(2),30,err=900)  s02
               mode = 0
            elseif (itok .eq. 42)  then
!              XES ( emin  emax estep)
               if (ixc0.lt.0) ixc0 = 2
!              Use extended k range for xanes
               ispec = 2
!              to avoid problems with debye waller factors below the
!              edge, always use complex p for debye waller
               call wlog('  XES:')
!              keep the same grid variables names as in XANES card
!              with new meaning for ispec=2: xkmax=emin, xkstep=emax
!              and vixan=estep
               xkstep=0.01d0
               if (nwords.gt.1) read(words(2),30,err=900)  xkmax 
               if (nwords.gt.2) read(words(3),30,err=900)  xkstep
               if (nwords.gt.3) read(words(4),30,err=900)  vixan
!              sanity checks
               !xkstep = 0.01d0 : JK changed xkstep to max energy.
               if (xkstep.le.xkmax) xkstep=0.01d0
               if (xkmax.ge.0) xkmax = -40.d0
               mode = 0
            elseif (itok .eq. 43)  then
!              DANES ( xkmax  xkstep vixan)
               if (ixc0.lt.0) ixc0 = 2
!              Use extended k range for xanes
               ispec = 3
!              to avoid problems with debye waller factors below the
!              edge, always use complex p for debye waller
               call wlog('  DANES:')
!              set the energy grid. xkstep - step in k to use for high
!              energies up to kmax. Near the Fermi level the energy
!              grid is regular in energy with step=vixan
!              the default value is vixan=gamma_ch/2+vi
               if (nwords.gt.1) read(words(2),30,err=900)  xkmax 
               if (nwords.gt.2) read(words(3),30,err=900)  xkstep
               if (nwords.gt.3) read(words(4),30,err=900)  vixan
!              sanity checks
               if (xkstep.lt.0.01) xkstep = 0.01d0
!              if (xkstep.gt.1.0) xkstep = 1.0d0
               if (xkmax.lt.2) xkmax = 2.d0
!              if (xkmax.gt.30) xkmax = 30.d0
               mode = 0
            elseif (itok .eq. 44)  then
!              FPRIME  emin emax estep
               if (ixc0.lt.0) ixc0 = 2
!              Use extended k range for xanes
               ispec = 4
               call wlog(' FPRIME:')
!              set the energy grid. 
               read(words(2),30,err=900)  xkmax 
               read(words(3),30,err=900)  xkstep
               if (nwords.gt.3) read(words(4),30,err=900)  vixan
!              sanity checks
               if (xkstep.lt.xkmax) xkstep = xkmax
               mode = 0
            elseif (itok .eq. 45)  then
!              RSIGMA  (real self energy only)
               call wlog(' Real self energy only will be used.  ' //    &
     &                   'FEFF results will be unreliable.')
               if (lreal.lt.1) lreal = 1
               mode = 0
            elseif (itok .eq. 46)  then
!              XNCD or XMCD
               ipol = 2
               mode = 0
            elseif (itok .eq. 47)  then
!              MULTIPOLES le2 (l2lp)
               read(words(2),20,err=900)  le2
               if (nwords.gt.2) read(words(3),20,err=900)  l2lp
               mode = 0
            elseif (itok .eq. 48)  then
!              UNFREEZEF   
               iunf = 1
               mode = 0
            elseif (itok .eq. 49)  then
!              TDLDA 
               izstd = 1
               if (nwords.gt.1) read(words(2),20,err=900)  ifxc
               mode = 0
            elseif (itok .eq. 50)  then
!              PMBSE 
               itdlda = 2
               if (nwords.gt.1) read(words(2),20,err=900)  ipmbse
               if (nwords.gt.2) read(words(3),20,err=900)  nonlocal
               if (nwords.gt.3.and.izstd.eq.0)                          &
     &                          read(words(4),20,err=900)  ifxc
               if (nwords.gt.4) read(words(5),20,err=900)  ibasis
               mode = 0
            elseif (itok .eq. 51)  then ! Added by Josh Kas
!              MPSE [iMP] (alias PLASMON)
!              iMP = 0, use feff default (card does nothing)
!              iMP = 1, use position independent SE, parameterized by the
!                       interstitial density.
!              iMP = 2, use position (density) dependent SE.
               if(nwords.gt.1) then
                  read(words(2),20,err=900) iPlsmn
               else
                  iPlsmn = 1
               end if
               if(nwords.gt.2) read(words(3),20,err=900) NPoles
!              Make old input run like before.
               if(iPlsmn .eq. 4) iPlsmn = 1
            elseif (itok .eq. 52)  then ! Added by Josh Kas
!              SFCONV
               msfconv = 1
            elseif (itok .eq. 53)  then ! Added by Josh Kas
!              SELF (print out on shell self energy Sig(k(E),E) )
               ipse = 1
            elseif (itok .eq. 54)  then ! Added by Josh Kas
!              SFSE k0 (print out self energy Sig(k0,E) ) 
               ipsk = 1
               read(words(2),30,err=900)  wsigk
            elseif (itok .eq. 55) then ! Added by Josh Kas
!              RCONV (print running convolution with file cfname at energy cen)
!              RCONV cen cname
               read(words(2),30,err=900) cen
               cfname = words(3)(1:12)
            elseif (itok.eq.56) then  !KJ added this card 1-06
!               ELNES
               eels=1   ! switch on ELNES
               absolu=1 !no renormalization in ff2x	       
!                  now follows the same code as for the XANES card
!              ELNES ( xkmax  xkstep vixan)
               if (ixc0.lt.0) ixc0 = 2
               ispec = 1
!              set the energy grid. xkstep - step in k to use for high
!              energies up to kmax. Near the Fermi level the energy
!              grid is regular in energy with step=vixan
!              the default value is vixan=gamma_ch/2+vi
               if (nwords.gt.1) read(words(2),30,err=900)  xkmax 
               if (nwords.gt.2) read(words(3),30,err=900)  xkstep
               if (nwords.gt.3) read(words(4),30,err=900)  vixan
!              sanity checks
               if (xkstep.lt.0.01) xkstep = dble(0.01)
               if (xkstep.gt.2.0) xkstep = dble(0.5)
               if (xkmax.lt.2) xkmax = dble(2)
               if (xkmax.gt.200) xkmax = dble(200)

                 ipol=1   ! override previous entries on POLARIZATION and ELLIPTICITY cards
                 elpty=0
        	 do i=1,3
                 evec(i)=dble(0)
        	 enddo
                 mode = 4  ! continue to read the rest of the ELNES card
                 icnt=5  ! number of lines to read
            elseif (itok.eq.57) then  !KJ added this card 1-06
!               EXELFS
               eels=1   ! switch on EXELFS
               absolu=1 !no renormalization in ff2x
!              EXAFS  xkmax for energy grid
               if (nwords.gt.1) read(words(2),30,err=900)  xkmax
                 ipol=1   ! override previous entries on POLARIZATION and ELLIPTICITY cards
                 elpty=0
        	 do i=1,3
                 evec(i)=dble(0)
        	 enddo
                 mode = 4  ! continue to read the rest of the EXELFS card
                 icnt=5  ! number of lines to read       
            elseif (itok .eq. 58) then !KJ added this card 1-06
!               MAGIC card
                 magic=1
                 read(words(2),30,err=900) emagic
                 icnt=5  ! number of lines to read	      
            elseif (itok .eq. 59) then !KJ added this card 3-06
!               ABSOLUTE card
                 absolu=1 !KJ end my addition 3-06
            elseif (itok .eq. 60) then !KJ added this card 6-06
!               SYMMETRY card
                 read(words(2),20) ica
        	 if (ica.lt.1.or.ica.gt.7) ica=-1
        	 write(slog,'(1x,a,i4,a)') 'SYMMETRY CARD - fixing             &
     &                 icase to ',ica,' in module PATH.'	    
                 call wlog(slog)
            elseif (itok .eq. 61) then   !KJ 8/06
!               REAL card
                  spacy=1
                  call wlog('We will work in real space.')
            elseif (itok .eq. 62) then  !KJ 8/06
!               RECIPROCAL card
                spacy=0
                call wlog('We will work in reciprocal space.')
            elseif (itok .eq. 63) then  !KJ 8/06
!               SGROUP card
                  read(words(2),20,err=900) sgroup
            elseif (itok .eq. 64) then  !KJ 8/06
!               LATTICE card
                  mode=5 !read lattice vectors now
        	  icnt=3 !expecting 3 lines of data
                  read(words(2),10,err=900) latticename
				  lattice(1:1)=latticename(1:1)
        	  if(nwords.gt.2) then
        	      read(words(3),*,err=900) scalelattice
        	  else
        	      scalelattice=dble(1)
        	  endif
              elseif (itok .eq. 65) then  !KJ 8/06
!               KMESH card
                  ! The number of k-points: could be "KMESH 1000" or "KMESH 10 20 5" or "KMESH 1000 0 0"
                  read(words(2),20,err=900) nkx
				  if(nwords.gt.2) then
				     read(words(3),20,err=900) nky
					 read(words(4),20,err=900) nkz
				  endif
				  nkp=nkx*nky*nkz
				  if(nkp.eq.0) nkp=nkx
				  
				  ! Strategy
				  ktype=1
				  if(nwords.gt.4) read(words(5),20,err=900) ktype
                  ! Apply symmetry to reduce k-mesh?
                  usesym=0				  
				  if(nwords.gt.5) read(words(6),20,err=900) usesym
            elseif (itok .eq. 66) then  !KJ 8/06
!               STRFAC card
                  read(words(2),30,err=900) streta
                  read(words(3),30,err=900) strgmax
                  read(words(4),30,err=900) strrmax
            elseif (itok .eq. 67) then  !KJ 8/06
!               BANDSTRUCTURE card
                  call wlog ('BANDSTRUCTURE card not functional yet.')
            elseif (itok .eq. 68) then !JK 8/09
!               COREHOLE hole_treatment    -   default is FSR
                if(nwords.gt.1) then
                   call upper(words(2))
                   if(TRIM(ADJUSTL(words(2))).eq.'NONE') then
                      nohole = 0
                   elseif(TRIM(ADJUSTL(words(2))).eq.'RPA') then
                      nohole = 2
                   elseif((TRIM(ADJUSTL(words(2))).eq.'FSR') .or. (TRIM(ADJUSTL(words(2))).eq.'REGULAR')) then
				      !I'm keeping 'regular' here for compatibility - don't tell John :)
                      nohole = -1
				   else 
				      call wlog('Invalid COREHOLE option - choose NONE, RPA, or FSR.')
					  stop
                   endif
                end if
            elseif (itok .eq. 71) then  !KJ 8.06
!               TARGET card
                read(words(2),20,err=900) absorber
            elseif (itok .eq. 72) then  !KJ 1.07
!               EGRID card
                if(nwords.gt.1) then
                    read(words(2),20,err=900) iegrid
                      if(iegrid.eq.2) then
         		 read(words(3),10,err=900) egridfile
                         call wlog('Energy grid to be read from file.')
                      elseif(iegrid.eq.3) then
                         read(words(3),20,err=900) egrid3a
                         read(words(4),30,err=900) egrid3b
                         read(words(5),30,err=900) egrid3c
                         call wlog('Energy grid on exponential mesh.')
                      else
                         iegrid=0
                         call wlog('Regular FEFF energy grid.')
                      endif
                else                    
                   iGrid = 1
                   mode=6
                   open(UNIT=15,FILE='grid.inp',STATUS='UNKNOWN')
                end if
            elseif (itok .eq. 73) then
!              COORDINATES icoord
               read(words(2),20,err=900) icoord	    		
               if(icoord.eq.1) then
                  call wlog('Atom positions are given in Carthesian coordinates.')
        	  call wlog('The units are Angstrom.')
        	  call wlog('FEFF-like coordinates.')
               elseif(icoord.eq.2) then
                  call wlog('Atom positions are given in Carthesian coordinates.')
        	  call wlog('The units are fractions of the resp. lattice vector.')
               elseif(icoord.eq.3) then
                  call wlog('Atom positions are given in Carthesian coordinates.')
        	  call wlog('The units are fractions of the first lattice vector.')
        	  call wlog('SPRKKR-like coordinates.')
               elseif(icoord.eq.4) then
                  call wlog('Atom positions are given in lattice coordinates.')
        	  call wlog('The units are fractions of the resp. lattice vector.')
        	  call wlog('WIEN2k-like input (beware of funny lattice types).')
               elseif(icoord.eq.5) then
                  call wlog('Atom positions are given in lattice coordinates.')
        	  call wlog('The units are fractions of the first lattice vector.')
               elseif(icoord.eq.6) then
                  call wlog('Atom positions are given in lattice coordinates.')
        	  call wlog('The units are Angstrom.')
               else
                  call wlog('Attempt to enter funky lattice coordinates.')
        	  call wlog('Please stick to one of the formats described in the manual.')
        	  call wlog('Exiting now.')
        	  stop
               endif
               
            elseif (itok .eq. 74) then
!              EXTPOT
               ExternalPot = .TRUE.
            elseif (itok .eq. 75) then
               ! CHBROAD
               read(words(2),20,err=900) iGammaCH
            elseif (itok .eq. 76) then
!              Added by Fer
               read(words(2),*,err=900) ChSh_Type
            elseif (itok .eq. 77) then
               ! DIMS card
               ! First is nclusx, second is lx
               read(words(2),20,err=900) nclusxuserlimit
               read(words(3),20,err=900) lxuserlimit
            elseif (itok .eq. 78)  then
!              NRIXS card    !KJ merged 7/09 from feff8q !KJ 12/2010 merged APS code that treats several q's and MDFF
               read(words(2),20,err=900)  nq  !KJ 12/09 changed format 30 to 20
			   if (nq.lt.0) then
			      qaverage=.true.
				  nq=abs(nq)
			   else
			      qaverage=.false.
				  if(nq.eq.0) nq=1  ! nq=0 was allowed in feff8q and feff8qwithnq
			   endif
			   call make_qlist(nq)
			   !read the first vector from the current line:
			   if (qaverage) then
!                    just read one component, assume spherical averaging                  
                     read(words(3),30,err=900)  qvec(3)
				     if(nq.gt.1) then
					    read(words(4),30,err=900) dummy
						dummy2=0.d0; if(nwords.ge.5) read(words(5),30,err=900) dummy2
						qw(1)=dcmplx(dummy,dummy2) !weight
					 endif
                     qvec(2)=0.0d0
                     qvec(1)=0.0d0
				     qn(1)=qvec(3) !norm
                     if (qvec(3).le.0.0d0) then  
                        call wlog(' ERROR: momentum transfer negative or zero')
                        call par_stop(' ')
                     end if
			   else
                     read(words(3),30,err=900)  qvec(1)
                     read(words(4),30,err=900)  qvec(2)
                     read(words(5),30,err=900)  qvec(3)
				     if(nq.gt.1) then
					    read(words(6),30,err=900) dummy
						dummy2=0.d0; if(nwords.ge.7) read(words(7),30,err=900) dummy2
						qw(1)=dcmplx(dummy,dummy2)
					 endif
				     qn(1)=dsqrt(qvec(1)**2+qvec(2)**2+qvec(3)**2)
			   end if
			   qs(1,:)=qvec
			   !read all other vectors, one per line:
			   if(nq.gt.1) then
			   do i=2,nq
			      call rdline(jinit,line)
				  if(line.eq.'read_line_end')   line='END'
				  if(line.eq.'read_line_error') line='END'
				  nwords=nwordx
				  call bwords(line,nwords,words)
                  if (qaverage) then
				     if(nwords.lt.2) stop 'expecting "q qweight" in feff.inp'
!                    just read one component, assume spherical averaging                  
                     read(words(1),30,err=900) qvec(3)
					 read(words(2),30,err=900) dummy
					 dummy2=0.d0; if(nwords.ge.3) read(words(3),30,err=900) dummy2
					 qw(i)=dcmplx(dummy,dummy2)
                     qvec(2)=0.0d0
                     qvec(1)=0.0d0
				     qn(i)=qvec(3) !norm
                     if (qvec(3).le.0.0d0) then  
                        call wlog(' ERROR: momentum transfer negative or zero')
                        call par_stop(' ')
                     end if
                  else 
				     if(nwords.lt.4) stop 'expecting "qx qy qz qweight" in feff.inp'
                     read(words(1),30,err=900)  qvec(1)
                     read(words(2),30,err=900)  qvec(2)
                     read(words(3),30,err=900)  qvec(3)
					 read(words(4),30,err=900) dummy
					 dummy2=0.d0; if(nwords.ge.5) read(words(5),30,err=900) dummy2
					 qw(i)=dcmplx(dummy,dummy2)
				     qn(i)=dsqrt(qvec(1)**2+qvec(2)**2+qvec(3)**2)
                  end if
			      qs(i,:)=qvec
			   enddo
			   qvec=qs(1,:) ! This is a precaution, not sure if it's desirable.  fix later
			   endif ! nq>1
			   do_nrixs=1
               mode = 0
			elseif (itok .eq. 79) then  !KJ 7-09 merged from feff8q 
!              LJMAX lj   abs(LJMAX) gives the number of terms in the expansion
!               of e^{iqr} in terms of spherical Bessel functions.
!               Traditionally it was negative. Do not know if that is needed in this version.
               read(words(2),20,err=900)  lj
			elseif (itok .eq. 80) then  !KJ 7-09 merged from feff8q
!              LDEC ldecmx  : Calculate contributions from different l-final states.
               read(words(2),20,err=900)  ldecmx
            elseif (itok .eq. 81) then
            !SETEDGE - set excitation energies based on elam/mcmasters table
               lopt=.true.
            elseif (itok .eq. 82) then
!           EPS0 - set dielectric constant for MPSE calculation.
               read(words(2),30,err=900) Eps0
            elseif (itok .eq. 83) then
!           OPCONS - create loss.dat file for MPSE from internal database.
               run_opcons = .TRUE.
            elseif (itok .eq. 84) then
!           NUMDENS - set the number densities for creating loss.dat from database.
               read(words(2),20,err=900) iph
               IF(iph.gt.nphx) then
                  PRINT*, "iph > nphx in fefff.inp"
                  PRINT*, TRIM(ADJUSTL(line))
                  STOP
               END IF
               read(words(3),30) NumDens(iph)
            elseif (itok .eq. 85) then
!           PREPS - Print out epsilon from database.
               print_eps = .TRUE.
            elseif (itok .eq. 86) then
!           EGAP - Set gap energy for self-energy calculation.
               read(words(2),*) EGap
            elseif (itok .eq. 87) then
!           CHWIDTH - Set corehole lifetime manually instead of using the tables in COMMON/setgam.f90
               read(words(2),*) userChLifetime
               userchl=.true.
			elseif (itok .eq. 88) then
!           MDFF - Calculate the mixed dynamic form factor	(was called "ADAM" in first version, lol)		
			   imdff=1
			   if(nwords.ge.2) read(words(2),20,err=900) imdff
			   if(imdff.eq.2) then
			      if(nwords.eq.2) then  !use q and q' from the NRIXS list
				     qqmdff=-1.d0
				     cosmdff_dum=0.d0
				  elseif(nwords.eq.4) then  ! use only q from the NRIXS list; generate q' using:
			         read(words(3),30,err=900) qqmdff
			         read(words(4),30,err=900) cosmdff_dum
				  else  !invalid syntax
				     stop "fatal error in feff.inp - expecting:   MDFF 2  q'  angle              or     MDFF 2"
				  endif
			   endif
			   if(imdff.le.0) then
			      call wlog('MDFF calculation disabled.')
			   elseif(imdff.eq.3) then
			      call wlog("EELS type MDFF calculation selected - summed over all q,q' pairs")
			   elseif(imdff.eq.2) then
			      call wlog("NRIXS type MDFF calculation selected - for a single q,q' pair only.")
               elseif(imdff.eq.1) then
			      call wlog("NRIXS type MDFF calculation selected - summed over all q,q' pairs.")
			   else 
			      call wlog('Invalid MDFF option selected.')
				  call par_stop('RDINP-2')
			   endif
			elseif (itok .eq. 89) then
!           RESTART - get the initial potentials for SCF from a pot.bin file
			   StartFromFile = .true.
            elseif (itok .eq. 90) then
!           CONFIG - use non-standard electron configuration for some atoms	
	
			   if(words(2) .eq. 'file') then
			      configtype=2
			   elseif(words(2) .eq. 'feff7') then
			      configtype=7
               elseif(words(2) .eq. 'card') then
			      configtype=2
				  !simply dump whatever's in the card to a file 'config.inp'.
				  !if there are mistakes, the user will find out later.
				  read(words(3),*) j
				  open(62,file='config.inp',form='formatted',status='unknown') !,access='append')
				  do i=1,j
				     call rdline(jinit,line)
                     write(62,'(a)') line
				  enddo
				  close(62)
			   else
			      call wlog('Not sure why you used the CONFIG card; calculation will proceed with defaults.')
			   endif		
			elseif (itok .eq. 91) then
!           SCREEN - pass on some options to the facultative screen.inp file
               if (nwords.lt.3) then
			      stop 'SCREEN card must be followed by precisely two arguments, e.g. "SCREEN rfms 5.5"'
			   else 
			      str3=words(2)  !takes first 3 letters
				  read(words(3),*) dummy
				  call screen_inp_parse(str3,dummy) !KJ 1-2012 used to be "call screen_inp_parse_and_write(str3,dummy)"
				  call wlog(":INFO  User provides options for screen.inp")
			   endif
			elseif (itok .eq. 92) then
!			CIF - read crystal structure from .cif file
			   if (nwords.lt.2) stop 'Error - CIF card must be followed by filename e.g. file.cif'
			   read(words(2),'(a)') cifname
			   cifread=.true.
			elseif (itok .eq. 93) then
!           EQUIVALENCE - governs choosing of potential types from crystallographic information			
			   if (nwords.lt.2) call wlog('No equivalence type specified in EQUIVALENCE card - using default.')
               read(words(2),*) cif_equivalence
			elseif (itok .eq. 94) then
!           COMPTON - calculates Compton profile
               do_compton = .true.
               save_g0 = .true.
               save_compton_info = .true.
			   ltmp=0  !KJ 10-2012 bugfix for Win "ltmp used without being defined"
               if (nwords.gt.1) read(words(2),30,err=900) pqmax
               if (nwords.gt.2) read(words(3),20,err=900) npq
               if (nwords.gt.3) read(words(4),20,err=900) ltmp
               if (ltmp.gt.0) force_jzzp = .true.
			elseif (itok .eq. 95) then
!           RHOZZP - calculate rho(z,z') along a slice
               save_g0 = .true.
               save_compton_info = .true.
               do_rhozzp = .true.
			elseif (itok .eq. 96) then
!           CGRID - grid parameters for JPQ
              if (nwords.gt.1) read(words(2),30,err=900) zpmax
              if (nwords.gt.2) read(words(3),20,err=900) ns
              if (nwords.gt.3) read(words(4),20,err=900) nphi
              if (nwords.gt.4) read(words(5),20,err=900) nz
              if (nwords.gt.5) read(words(6),20,err=900) nzp
			elseif (itok .eq. 97) then
!			CORVAL - set minimum energy for core-valence separation energy search
!             This card is a temporary fix until we fix the core-valence problem properly (FEFF9.7?)
			  if (nwords.gt.1) then
			     read(words(2),30,err=900) corval_emin ! eV
			  else
			     call wlog('Ignoring CORVAL card without parameter corval_emin')
			  endif
            elseif (itok .eq. -1)  then
!              END
               goto 220
            else
               write(slog,'(1x,a)') line(1:70)
               call wlog(slog)
               write(slog,'(1x,a)') words(1)
               call wlog(slog)
               write(slog,'(a,i8)') ' Token ', itok
               call wlog(slog)
               call wlog(' Keyword unrecognized.')
               call wlog(' See FEFF document -- some old features')
               call wlog(' are no longer available.')
               call par_stop('RDINP-2')
            endif
         elseif (mode .eq. 1)  then
            if (itok .ne. 0)  then
!              We're done reading atoms.
!              Change mode and process current card.
               mode = 0
               goto 210
            endif
            natt = natt+1
            if (natt.gt. nattx)  then
               write(slog,'(a,i8)') 'Too many atoms, max is ', nattx
               call wlog(slog)
               call par_stop('RDINP-3')
            endif
            read(words(1),*,err=900)  ratx(1,natt)
            read(words(2),*,err=900)  ratx(2,natt)
            read(words(3),*,err=900)  ratx(3,natt)
            read(words(4),*,err=900)  iphatx(natt)
            if (iatph(iphatx(natt)) .le. 0) iatph(iphatx(natt)) = natt
         elseif (mode .eq. 2)  then
            if (itok .ne. 0)  then
!              We're done reading these overlap instructions.
!              Change mode and process current card.
               mode = 0
               goto 210
            endif
            novr(iph) = novr(iph)+1
            iovr = novr(iph)
            if (iovr .gt. novrx)  then
               write(slog,'(a,i8)') 'Too many overlap shells, max is ',  novrx
               call wlog(slog)
               call par_stop('RDINP-5')
            endif
            read(words(1),20,err=900) iphovr(iovr,iph)
            read(words(2),20,err=900) nnovr(iovr,iph)
            read(words(3),30,err=900) rovr(iovr,iph)
         elseif (mode .eq. 3)  then
            if (itok .ne. 0)  then
!              We're done reading unique potential definitions
!              Change mode and process current card.
               mode = 0
               goto 210
            endif
            read(words(1),20,err=900)  iph
            if (iph .lt. 0  .or.  iph .gt. nphx)  then
               write(slog,'(a,i8)')  'Unique potentials must be between 0 and ',nphx
               call wlog(slog)
               write(slog,'(i8,a)') iph, ' not allowed'
               call wlog(slog)
               write(slog,'(1x,a)') line(1:71)
               call wlog(slog)
               call par_stop('RDINP')
            endif
            read(words(2),20,err=900)  iz(iph)
            if (iz(iph).lt. 6) then
               lmaxsc(iph) = 1
            elseif (iz(iph).lt.55) then
               lmaxsc(iph) = 2
            else
               lmaxsc(iph) = 3
            endif
!           No potential label if user didn't give us one
!           Default set above is potlbl=' '
            if (nwords .ge. 3)  potlbl(iph) = words(3)
            if (nwords .ge. 4)  then
              read(words(4),20,err=900) ltmp
!KJ lx now dynamic             if (ltmp.ge.1 .and. ltmp.le.lx) lmaxsc(iph) = ltmp
              if (ltmp.ge.1) lmaxsc(iph) = ltmp
            endif
            lmaxph(iph) = 3
            if (iz(iph).lt.6) lmaxph(iph) = 2
            if (nwords .ge. 5)  then
              read(words(5),20,err=900) ltmp
!KJ lx now dynamic              if (ltmp.ge.1 .and. ltmp.le.lx) lmaxph(iph) = ltmp
              if (ltmp.ge.1) lmaxph(iph) = ltmp
            endif
            if (nwords .ge. 6) then
              read(words(6),30,err=900) xnatph(iph)
              lxnat = 1
            endif
            if (nwords .ge. 7) then
              read(words(7),30,err=900) spinph(iph)
            endif
			nph_read=iph
           elseif (mode.eq.4) then  !KJ 1-06 this mode added to read ELNES card
             if(icnt.eq.5) then
                 call fixlinenow(words,nwords)
                 read(words(1),*,err=900) ebeam   ! read beam energy in keV
                 ebeam=ebeam * dble(1000)  ! convert to eV
                 if (nwords.ge.2) read(words(2),20,err=900) aver ! average over sample to beam orientation?
        	     if (aver.eq.1) icnt=icnt-1 !skip the line for beam orientation
                 if (nwords.ge.3) read(words(3),20,err=900) cross ! calculate cross terms?
                 if (nwords.ge.4) read(words(4),20,err=900) relat ! use relativistic q-vector?
        	     if (nwords.ge.5) read(words(5),20,err=900) iinput ! read xmu.dat or opconsKK.dat or ... ?   !KJ 5/6
                 if (nwords.ge.6) read(words(6),20,err=900) spcol !column that has spectrum
              elseif(icnt.eq.4) then
                 read(words(1),*,err=900) xivec(1)  ! read direction of incoming beam
                 read(words(2),*,err=900) xivec(2)  ! in arbitrary units
                 read(words(3),*,err=900) xivec(3)
                 xinorm=dsqrt(xivec(1)**2+xivec(2)**2+xivec(3)**2)
        	     if (xinorm.gt.0.0) then
        	        do i=1,3
                       xivec(i)=xivec(i)/xinorm    ! normalize this vector.
        	        enddo
        	     elseif(.not.(aver.eq.1)) then
        	        call wlog('WARNING : beam direction unspecified in orientation sensitive EELS calculation.      &
     &                  Please correct before running EELS module.')
        	     endif
             elseif(icnt.eq.3) then
                 read(words(1),*,err=900) acoll  ! collection semiangle in mrad
                 read(words(2),*,err=900) aconv  ! convergence semiangle in mrad
                 acoll=acoll/dble(1000);aconv=aconv/dble(1000) ! convert from mrad to rad
             elseif(icnt.eq.2) then
                 read(words(1),*,err=900) nqr    ! specify q-mesh, radial parameter
                 read(words(2),*,err=900) nqf    ! specify q-mesh, angular parameter
        	     if(nqr*nqf.eq.0) then
        	        call wlog('WARNING : zero q-mesh points specified for EELS calculation.  Please correct before       &
     &               running EELS module.')
                 endif
             elseif(icnt.eq.1) then
                 read(words(1),*,err=900) thetax ! detector position in plane perpendicular to beam ; angle in mrad
                 read(words(2),*,err=900) thetay ! detector position in plane perpendicular to beam ; angle in mrad
        	       thetax=thetax/dble(1000);thetay=thetay/dble(1000) !mrad to rad
                 mode=0  ! finished reading ELNES card
             endif
             icnt=icnt-1    ! now read the next line
         !KJ end my changes                            
         elseif (mode.eq.5) then  !KJ 04/2007 read lattice vectors
              if(icnt.eq.3) then
                  read(words(1),*,err=900) a1(1)
                  read(words(2),*,err=900) a1(2)
                  read(words(3),*,err=900) a1(3)
        	  a1=a1*scalelattice
              elseif(icnt.eq.2) then
                  read(words(1),*,err=900) a2(1)
                  read(words(2),*,err=900) a2(2)
                  read(words(3),*,err=900) a2(3)
        	  a2=a2*scalelattice
              elseif(icnt.eq.1) then
                  read(words(1),*,err=900) a3(1)
                  read(words(2),*,err=900) a3(2)
                  read(words(3),*,err=900) a3(3)
        	  a3=a3*scalelattice
              endif		  
              icnt=icnt-1
              if(icnt.eq.0) mode=0  !finished reading LATTICE card
         elseif (mode.eq.6) then ! Josh Kas 11/2009 egrid input              
              ! Just write this to grid.inp 
              if(itok.eq.0) then
                 write(15,*) (TRIM(ADJUSTL(words(i))) // ' ', i=1, nwords)
              else
                 ! Done reading egrid input.
                 mode=0
                 goto 210
              end if
         else
            write(slog,'(a,i8)') 'Mode unrecognized, mode ', mode
            call wlog(slog)
            call par_stop('RDINP-6')
         endif
      goto 200
  220 continue
! DONE READING INPUT FILE, 
!#{mn
! call rdline with jinit=0 to clean up all input files
       jinit = 0
       call rdline(jinit,line)
!#mn}

! ##########################################################################################


!     Fix up defaults, error check limits, figure out free atoms, etc.


      if (spacy.eq.1 .and. cifread)  call wlog('CIF input option ignored for real space calculation.')
	  
	  if (cifread .and. cards_set(1))  call wlog('CIF and ATOMS cards used: ATOMS card will be ignored.')
	  

! !KJ 8/06 copy data from ATOMS card to dedicated arrays :
      if (spacy.eq.0 .and. (.not.cifread)) then
	  
		 call wlog('Taking crystal structure from feff.inp.  Note: .cif input is now recommended!')
		 ! Convert the allowed coordinate system input to the one used internally:
		 nats=natt !KJ bugfix 2-2012
         if(icoord.eq.1) then
            alatt=dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)
            ratx=ratx/alatt
         elseif(icoord.eq.2) then
            alatt=dsqrt(a2(1)**2+a2(2)**2+a2(3)**2)
            ratx(2,:)=ratx(2,:)*alatt
            alatt=dsqrt(a3(1)**2+a3(2)**2+a3(3)**2)
            ratx(3,:)=ratx(3,:)*alatt
            alatt=dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)
            ratx(2:3,:)=ratx(2:3,:)/alatt
         elseif(icoord.eq.3) then
! no action required ; this is default
         elseif(icoord.eq.4) then
            alatt=dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)
            do iatrd=1,nats
               xxx(1)=a1(1)*ratx(1,iatrd)+a2(1)*ratx(2,iatrd)+a3(1)*ratx(3,iatrd)
               xxx(2)=a1(2)*ratx(1,iatrd)+a2(2)*ratx(2,iatrd)+a3(2)*ratx(3,iatrd)
               xxx(3)=a1(3)*ratx(1,iatrd)+a2(3)*ratx(2,iatrd)+a3(3)*ratx(3,iatrd)
               ratx(:,iatrd)=xxx/alatt
            enddo
         elseif(icoord.eq.5) then
            alatt=dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)
            ratx(2:3,:)=ratx(2:3,:)*alatt
            alatt=dsqrt(a2(1)**2+a2(2)**2+a2(3)**2)
            ratx(2,:)=ratx(2,:)/alatt
            alatt=dsqrt(a3(1)**2+a3(2)**2+a3(3)**2)
            ratx(3,:)=ratx(3,:)/alatt
            do iatrd=1,nats
               xxx(1)=a1(1)*ratx(1,iatrd)+a2(1)*ratx(2,iatrd)+a3(1)*ratx(3,iatrd)
               xxx(2)=a1(2)*ratx(1,iatrd)+a2(2)*ratx(2,iatrd)+a3(2)*ratx(3,iatrd)
               xxx(3)=a1(3)*ratx(1,iatrd)+a2(3)*ratx(2,iatrd)+a3(3)*ratx(3,iatrd)
               ratx(:,iatrd)=xxx/alatt
            enddo
         elseif(icoord.eq.6) then
            alatt=dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)
            ratx(1,:)=ratx(1,:)/alatt
            alatt=dsqrt(a2(1)**2+a2(2)**2+a2(3)**2)
            ratx(2,:)=ratx(2,:)/alatt
            alatt=dsqrt(a3(1)**2+a3(2)**2+a3(3)**2)
            ratx(3,:)=ratx(3,:)/alatt
            do iatrd=1,nats
               xxx(1)=a1(1)*ratx(1,iatrd)+a2(1)*ratx(2,iatrd)+a3(1)*ratx(3,iatrd)
               xxx(2)=a1(2)*ratx(1,iatrd)+a2(2)*ratx(2,iatrd)+a3(2)*ratx(3,iatrd)
               xxx(3)=a1(3)*ratx(1,iatrd)+a2(3)*ratx(2,iatrd)+a3(3)*ratx(3,iatrd)
               ratx(:,iatrd)=xxx/alatt
            enddo
         endif

           call init_struct(natt)
           nats=natt
           ppos(1:3,1:nats)=ratx(1:3,1:nats)
           ppot(1:nats)=iphatx(1:nats)
!!! Disable the next section
!!    It is expected that coordinates are given in FRACTIONAL COORDINATES!!
!               do i=1,3
!                 do iatrd=1,nats
!!     Reduce atom positions to first unit cell [0,1]^3
!                   if(dabs(ppos(i,iatrd)).gt.dble(1))                   &
!     &	          ppos(i,iatrd)=ppos(i,iatrd)-int(ppos(i,iatrd))
!                   if(ppos(i,iatrd).lt.dble(0))                         &
!     &              ppos(i,iatrd)=ppos(i,iatrd)+dble(1) !KJ fix later
!                 enddo
!               enddo

		elseif (spacy.eq.0 .and. cifread) then
		   call wlog('Taking crystal structure from .cif file.')
		   call importcif(cifname,cif_equivalence)
           !importcif creates ppos,ppot,a1,a2,a3 and more.  init_struct is called inside.

		   !Now deal with the settings of the POTENTIALS card:
           if (cards_set(14)) then  !POTENTIALS card in feff.inp
		      ! First check that POTENTIALS and cif file are compatible:
!              call wlog(':WARNING  You are using CIF import and POTENTIALS card.  Make sure the two correspond perfectly!')	
			  if(nph_read.ne.nphstr) then
				call wlog(':WARNING  POTENTIALS card contains different number of potentials than cif file.  Ignoring POTENTIALS card.')
				cards_set(14)=.false.
			  endif 
			  nph=nphstr
			  do iph=0,nph
			     if(iz(iph).ne.izatom(iph)) then
					call wlog(':WARNING   POTENTIALS card contains different atomic number than cif file.  Ignoring POTENTIALS card.')
					cards_set(14)=.false.
				 endif 
			  enddo
			  if (cards_set(14)) then
			     !All compatibility checks passed!
				 !Now the data from the POTENTIALS card can just be kept as is :
				 ! iz,potlbl,lmaxsc,lmaxph,xnatph,spinph
			  endif
		   endif
		   if (.not.cards_set(14)) then  !no POTENTIALS card in feff.inp
		      nph=nphstr
			  iz(:)=-1 !careful: this must not be initialized to "0"!
			  iz(0:nph)=izatom(0:nph)
			  do iph=0,nph  ! carefully convert 2-string to 6-string
			     potlbl(iph)='      '
				 str6(1:2)=label(iph)
				 str6(3:6)='    '
				 potlbl(iph)=str6
			  enddo
			  do iph=0,nph
			     ! lmaxsc and lmaxph will be set to defaults:
	             if (iz(iph).lt. 6) then
                   lmaxsc(iph) = 1
				   lmaxph(iph) = 2
                 elseif (iz(iph).lt.55) then
                   lmaxsc(iph) = 2
				   lmaxph(iph) = 3
                 else
                   lmaxsc(iph) = 3
				   lmaxph(iph) = 3
                 endif
			  enddo
			  ! set stoichiometry in xnatph:
			  lxnat=1
			  xnatph(0)=0.01d0
			  xnatph(1:nph)=natom(1:nph)			  
			  ! spinph CANNOT be set in the current implementation - the user must have a POTENTIALS card for that to work.
			  spinph(:)=0.d0
		   endif
		   
	   endif
	   
	   if (spacy.eq.0) then

!  The FMS routines need only that information.  However, the path expansion still needs a real space list of coordinates.
!  This list must now be generated, and placed in the arrays corresponding to the ATOMS card.
!  After that, initialization can continue.
!  we put the absorber in the center of the cell (at position 0,0,0)

         if ((absorber.lt.1.or.absorber.gt.nats)) then
               call wlog ('No absorber - assigning to first position.')
               absorber=1
         endif

!KJ I've decided to disable the following section for now, because it annoys me.
!However, someone else may choose to activate it to be compatible with something in FEFF ...  
!This piece of code essentially puts the core hole at position 0,0,0 and first in the list of coordinates in the unit cell.
!If using it, make sure you adjust the setting of the TARGET card variables!  Otherwise, you'll calculate the wrong edge!!
!!!!Skipped code:
!         
!!        first save absorber position
!         sss=ppos(:,absorber)
!         do i=1,nats
!         do j=1,3
!              ppos(j,i)=ppos(j,i)-sss(j)
!           enddo
!           enddo
!!  it's probably unnecessary, but still I put the absorber at position 1 in the list :
!         do j=1,3
!              dummy=ppos(j,1)
!              ppos(j,1)=ppos(j,absorber)
!              ppos(j,absorber)=dummy
!         enddo
!         i=ppot(absorber)
!         ppot(absorber)=ppot(1)
!         ppot(1)=i
!         absorber=1
!KJ End of skipped block	 
         
!  Now we replace atoms-list from feff.inp by one generated from the atoms in pos by periodic repetition.

         magnifier=2.d0
         ratomslist=max(8.d0,min(magnifier*rmax,rmax))
         i1=max(int(ratomslist/dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)),2)
         i2=max(int(ratomslist/dsqrt(a2(1)**2+a2(2)**2+a2(3)**2)),2)
         i3=max(int(ratomslist/dsqrt(a3(1)**2+a3(2)**2+a3(3)**2)),2)
		 if(lattice.eq.'P'.or.lattice.eq.'H') then
		    lattice_factor=1
		 elseif(lattice.eq.'F') then
		    lattice_factor=4
		 else
		    lattice_factor=2
		 endif
4245     continue  !Come back here to try again if the first list was too long
         j=nats*(2*i1+1)*(2*i2+1)*(2*i3+1)*lattice_factor
         alatt=dsqrt(a1(1)**2+a1(2)**2+a1(3)**2)
         if(j.gt.nattx) then
		      if(i1+i2+i3.eq.3) then
                 call par_stop ('WARNING - current value of nattx does not allow to calculate up to rmax as specified in feff.inp')
			  else
			     i1=1
				 i2=1
				 i3=1
				 goto 4245
			  endif
         endif
		      nshift=0
		      shift(:,:)=0.d0
			  if(lattice.eq.'F') then
			     nshift=3
				 shift(1,1)=0.5d0 ; shift(2,1)=0.5d0
				 shift(1,2)=0.5d0 ; shift(3,2)=0.5d0
				 shift(3,3)=0.5d0 ; shift(2,3)=0.5d0
			  elseif(lattice.eq.'R') then
			     nshift=1
				 stop 'eek'
			  elseif(lattice.eq.'CXY') then
			     nshift=1
				 shift(1,1)=0.5d0 ; shift(2,1)=0.5d0
			  elseif(lattice.eq.'CXZ') then
			     nshift=1
				 shift(1,1)=0.5d0 ; shift(3,1)=0.5d0
			  elseif(lattice.eq.'CYZ') then
			     nshift=1
				 shift(3,1)=0.5d0 ; shift(2,1)=0.5d0
			  elseif(lattice.eq.'I'.or.lattice.eq.'B') then
                 nshift=1
                 shift(1,1)=0.5d0 ; shift(2,1)=0.5d0 ; shift(3,1)=0.5d0
			  endif  !If P or H, no need to make extra atoms

         natt=0
         do j1=-(i1),i1
         do j2=-(i2),i2
         do j3=-(i3),i3
         do i=1,nats
            natt=natt+1  ! create one more atom
            ratx(:,natt)=ppos(:,i)*alatt+dble(j1)*a1+dble(j2)*a2+dble(j3)*a3
            iphatx(natt)=ppot(i)
              if((j1.eq.0.and.j2.eq.0.and.j3.eq.0).and.i.eq.absorber) then 
				iphatx(natt)=0  ! absorber
        		indexabs=natt
              endif
              if (iatph(iphatx(natt)).le.0) iatph(iphatx(natt))=natt
			  if(nshift.gt.0) then
			     do j=1,nshift
			        natt=natt+1
				    ratx(:,natt)=ratx(:,natt-j)+shift(1,j)*a1+shift(2,j)*a2+shift(3,j)*a3
				    iphatx(natt)=ppot(i)
!					write(*,*) j1,j2,j3,i,j,ratx(:,natt),ratx(:,natt-1)
				 enddo
			  endif  !If P or H, no need to make extra atoms
         enddo
         enddo
         enddo
         enddo
! ratx is now an array in Carthesian coordinates and in Angstrom units.
         iz(0)=iz(ppot(absorber)) !KJ 11-2009 avoids triggering overlap part below

         distance=dble(0)
         do i=1,natt
             distance(i)=dsqrt((ratx(1,i)-ppos(1,absorber)*alatt)**2+(ratx(2,i)-ppos(2,absorber)*alatt)**2&
     &	     +(ratx(3,i)-ppos(3,absorber)*alatt)**2)
         enddo
         do i=1,natt
            k=i
            mindist=distance(i)
            do j=i,natt
               if(distance(j).lt.mindist) then
                  k=j
                  mindist=distance(j)
               endif
            enddo
            sss=ratx(:,i)
            ratx(:,i)=ratx(:,k)
            ratx(:,k)=sss
            distance(k)=distance(i)
            distance(i)=mindist
            j=iphatx(i)
            iphatx(i)=iphatx(k)
            iphatx(k)=j
            if(i.eq.indexabs) indexabs=k
            if(k.eq.indexabs) indexabs=i
            if(iatph(iphatx(i)).eq.i) iatph(iphatx(k))=k
            if(iatph(iphatx(k)).eq.k) iatph(iphatx(k))=i
         enddo
         
      endif
! !KJ



!KJ check on treatment of core hole in case of k-space calculations :
      if(spacy.eq.0.and.nohole.ne.0.and.nohole.ne.2) then
         call wlog('You have requested a k-space calculation, with a conventional core hole calculation.')
         call wlog('The recommended strategy is to use COREHOLE NONE (ground state calculation)')
         call wlog('or COREHOLE RPA  (statically screened core hole) for k-space.')
      endif

!KJ prepare true nohole calculation in k-space (NOHOLE 2 counts as a core hole calculation as far as kspace is concerned)
      if(spacy.eq.0.and.nohole.eq.0) then
	     icorehole = 0   ! this will set the variable 'corehole' in FMS through reciprocal.inp
		                 ! for NOHOLE 2, reapot will choose to ignore the core hole - see reapot.f90
	  endif


! !KJ added this check 1-06
      if(magic.eq.1.and.(eels.ne.1)) then
          call wlog('To use MAGIC card you must have ELNES card.  Ignoring MAGIC card.')
          magic=0
        endif
! !KJ

!  !KJ another check for eels 1-06
      if((eels.eq.1).and.(aver.eq.1).and.(cross.eq.1)) then
          call wlog('WARNING : you have asked to calculate an orientation averaged spectrum, but you have also asked         &
     &   to calculate cross-terms.  Averaging kills the cross terms.  Hence the program ignores your request and does not calculate cross terms.')
      endif
!  !KJ

!  !KJ  set up a variable needed for elnes 1-06
        if(eels.eq.1) then
          if(aver.eq.1) then
             ipstep=1
             ipmin=10
             ipmax=10
          else
            ipmin=1
            ipmax=9
            if(cross.eq.1) then
               ipstep=1
            else
               ipstep=4
            endif
          endif
        endif
!  !KJ

!KJ:   For MDFF calculations:  12-2010 and 03-2011
      !SANITY CHECKS
      if(do_nrixs.eq.1 .and. (imdff.eq.1 .or. imdff.eq.2)) then
	     mixdff=.true.
	  elseif(imdff.eq.1 .or. imdff.eq.2) then
	     call wlog('ERROR - the selected MDFF option is only available with the NRIXS card.')
		 call par_stop('RDINP')	     
	  else
	     mixdff=.false.
	  endif
	  
	  if((imdff.eq.2).and.(nq.ne.2)) then
	     call wlog("Current version of this type of MDFF calculation requires that you set nq=2 in the NRIXS card.")
		 call par_stop(" ")
      endif
	  if((imdff.eq.2).and.((dabs(cosmdff_dum)-dble(1)).lt.0.01d0)) then
	     call wlog("Just letting you know - you're calculating a DFF using MDFF technology.  Should work fine, but quite unnecessary.")
      endif
	  if((imdff.eq.3) .and. .not.(cards_set(56).or.cards_set(57))) then
	     call wlog("The selected MDFF option requires the ELNES or EXELFS card.  Aborting now.")
	  endif
	  	  
      !Initialize q' for "type 2" MDFF calculations
	  if(imdff.eq.2) then
	     if(qqmdff.ge.0.d0) then
		    !make a new q' based on the parameters given in the MDFF card
			!q' == q, scaled to length qqmdff, rotated around x-axis by angle cosmdff_dum
			!I've freely chosen the rotation axis since user input only fixes 2 degrees of freedom for q'
			!If user wants to choose all 3, they should use the NRIXS list (i.e. don't specify qqmdff in feff.inp)
			dummy=qqmdff/qn(1)  ! q' / q
			qs(2,1)=qs(1,1)*dummy
			qs(2,2)=dummy*(  qs(1,2)*dcos(cosmdff_dum *pi/180.d0) + qs(1,3)*dsin(cosmdff_dum *pi/180.d0) )
			qs(2,3)=dummy*( -qs(1,2)*dsin(cosmdff_dum *pi/180.d0) + qs(1,3)*dcos(cosmdff_dum *pi/180.d0) )			
		 else 
		    !just use the q' as specified in the NRIXS card
		 endif		 
	  endif
	  
	  !initialize q,q' angles for MDFF+NRIXS calculation
	  if(mixdff) then
		 do iq=1,nq
		 do iqq=1,nq
			cosmdff(iq,iqq)=dcos(pi/180.d0 * ((qs(iq,1)*qs(iqq,1)+qs(iq,2)*qs(iqq,2)+qs(iq,3)*qs(iqq,3))/(qn(iq)*qn(iqq))) )   ! cos<q,q'> = cos( q.q' /q /q')
		 enddo
		 enddo
	  endif
!:KJ	  

!KJ :
!     NRIXS sanity checks and initialization:
      if (do_nrixs.eq.1) then
         xivec=qvec   !overwriting variables is OK since nrixs can never be combined with pola,elli,...
		 if(enforce_alexis_exchange_policy) then
		    call wlog('EXCHANGE ignored for NRIXS calculation.')
		    vr0=0.d0
		    vi0=0.d0
		 endif
		 le2=lj
		 elpty=nq
		 if(xkmax.lt.0.d0) call wlog('Uniform energy mesh selected.')
         call init_feffq   !calculate xivnorm
		 if (xivnorm.lt.0.01) call wlog('Warning - NRIXS calculation with very small q-vector.  Results may be bad.')
		 if(ica.gt.0 .and. ica.lt.8) call wlog('Warning - SYMMETRY card ignored because of polarized NRIXS calculation.')
		 if(.not. qaverage) then
		    ica=7  !disables all symmetry in the Path Expansion.
		 else
		    ica=5  !disables most symmetry in the Path Expansion ; any rotation around z allowed.
		 endif
	     call make_qtrig
!OK     * set vr0=vri=0
!OK     * disable ELLIP, POLA, NSTAR, SPIN, CFAV, XNCD, RPHASES, TDLDA, XES, PMBSE
!OK     * warn about constant step energy grids for negative kmax - first find out how it works :)
!OK     * get lj into le2 (what Aleksi used - ripped from MULT card - and written to global.inp by wrtall)
!OK     * get nq and qvec into whatever Aleksi "stole" from the ?? card
!OK     * give warnings if momentum transfer small or large.  Aleksi put these in mkptz, but this gets tricky
!       since in the general version of feff, the vectors are used for different purposes, and I want to avoid
!       mess in low-level routines if possible (ie, better to have the "if nrixs" loop here than in mkptz).
!       Aleksi warns if smaller than 0.01 - random value.
!OK     * NOTE TO SELF : fix mkptz evec block
      endif

!-KJ


!     need smaller rgrid for nonlocal exchange
      if (ixc0.lt.0) ixc0 = 0 !for EXAFS, EXELFS (maybe NRIXS also?)
      if (mod(ixc, 10).ge.5 .and. rgrd.gt.0.03) rgrd=0.03d0 
      if (mod(ixc0,10).ge.5 .and. rgrd.gt.0.03) rgrd=0.03d0 
!     must use linear polarization to use nstar
      if (wnstar)  then
         if (ipol.ne.1)  then
            call wlog(' Must have linear polarization to use NSTAR.')
            call wlog(' NSTAR will be turned off.')
            wnstar = .false.
         endif
      endif

!     Do not use ihole .le. 0
      if (ihole .le. 0)  then
         call wlog(' Use NOHOLE to calculate without core hole.')
         call wlog(' Only ihole greater than zero are allowed.')
         call par_stop('RDINP')
      endif

!     Find out how many unique potentials we have
!     in POTENTIAL card
      nph = 0
      do 300  iph = nphx, 0, -1
         if (iz(iph) .gt. -1)  then
            nph = iph
            goto 301
         endif
  300 continue
  301 continue


!     cannot use OVERLAP and ATOMS cards together
      if (iatom .gt. 0 .and. iovrlp .gt. 0)  then
        call wlog(' Cannot use ATOMS and OVERLAP in the same feff.inp.')
        call par_stop('RDINP')
      endif

!     cannot use OVERLAP and CFAVERAGE   cards together
      if (novr(0) .gt. 0) then
!        OVERLAP is used, cannot do configuration average
         iphabs = 0
         nabs = 1
         rclabs = big
      endif


!     Must have central atom
      if (iz(0) .le. 0)  then
         if (iphabs .gt. 0) then
!           central atom is of the iphabs type
            iz(0) = iz(iphabs)
            potlbl(0) = potlbl(iphabs)
            lmaxsc(0) = lmaxsc(iphabs)
            lmaxph(0) = lmaxph(iphabs)
            xion(0) = xion(iphabs)
         else
            call wlog(' No absorbing atom (unique pot 0) was defined.')
            call par_stop('RDINP')
         endif
      endif

!     No gaps allowed in unique pots.  Make sure we have enough
!     to overlap all unique pots 0 to nph.
      if (iphabs.gt.0 .and. iatph(0).le.0)   iatph(0) = iatph(iphabs)
      do 340  iph = 0, nph
         if (iatph(iph) .le. 0  .and.  novr(iph) .le. 0)  then
!           No model atom, no overlap cards, can't do this unique pot
            write(slog,'(a,i8)') ' No atoms or overlap cards for unique pot ', iph
            call wlog(slog)
            call wlog(' Cannot calculate potentials, etc.')
            call par_stop('RDINP-')
         endif
!        by default freeze f-electrons and reset lmaxsc=2
         if (iunf.eq.0 .and. lmaxsc(iph).gt.2) then
		    write(slog,'(a,i4,a)') 'Resetting lmaxsc to 2 for iph = ',iph,'.  Use  UNFREEZE to prevent this.'
		    call wlog(slog)
		    lmaxsc(iph)=2
		 endif
  340 continue

!     Need number of atoms of each unique pot, count them.  If none,
!     set to one. Do statistics for all atoms in feff.inp.
      do iph = 0, nph
        if (lxnat.eq.0) then 
          xnatph(iph) = 0
          do iat = 1, natt
              if (iphatx(iat) .eq. iph)  xnatph(iph) = xnatph(iph)+1
          enddo
          if (iph.gt.0 .and. iph.eq.iphabs) xnatph(iph) = xnatph(iph)-1
        else
          if (xnatph(iph).le. 0.01) then
            if (iph.eq.0) then
              xnatph(iph) = 0.01d0
            else
              write (slog,'(a,i4)') ' Inconsistency in POTENTIAL card is detected for unique pot ', iph
              call wlog (slog)
              call wlog (' Results might be meaningless.')
            endif
          endif
        endif
        if (xnatph(iph) .le. 0)  xnatph(iph) = 1
      enddo
      if (lxnat.ne.0) then
!        normalize statistics to have one absorber
         do 351 iph = 1, nph
  351    xnatph(iph) = xnatph(iph) /xnatph(0)
         xnatph(0) = 1
      endif
      xnat = 0
      do 352 iph = 0,nph
  352 xnat = xnat + xnatph(iph)

!     Find distance to nearest and most distant atom (use overlap card
!     if no atoms specified.)
      if (natt .lt. 2)  then
         ratmin = rovr(1,0)
         ratmax = rovr(novr(0),0)
      else
         ratmax = 0
         ratmin = 1.0e10
         iatabs = iatph(0)
         icount = 0
         if (iatabs.le.0) iatabs = iatph( iphabs)
         if (iatabs.le.0) call par_stop('RDINP fatal error: iatabs=NaN')

         do 412  iat = 1, natt
           if (iphatx(iat) .eq. iphabs .or. iphatx(iat).eq.0)  icount = icount +1
           if (iat.ne.iatabs) then
!           skip absorbing atom
            tmp = dist (ratx(1,iat), ratx(1,iatabs))
            if (tmp .gt. ratmax)  ratmax = tmp
            if (tmp .lt. ratmin)  ratmin = tmp
           endif
  412    continue
         if (nabs.le.0) nabs = icount
      endif

!     Set total volume
      if (totvol.gt.0) totvol = totvol * ratmin**3 * xnat

!     Set rfms if they are too small
      if (rfms1 .lt. ratmin) rfms1 = -1.e0
      if (rfms2 .lt. ratmin) rfms2 = -1.e0
      if (rfms2 .lt. ratmin .and. ispec.lt.2) ispec = - ispec 
      if (rfms2 .lt. ratmin .and. ispec.eq.3) ispec = - ispec 
!     if ispec.le.0 MS expansion will be used, else - FMS method.
      

!     Set rmax if necessary
      if (rmax.le.0 .and. nss.le.0 .and. ispec.le.0)  then
!        set to min (2+ times ratmin, ratmax) (magic numbers to
!        avoid roundoff, note that rmax is single precision).
         rmax = min (2.2 * ratmin, 1.01 * ratmax)
      endif

!     Set core hole lifetime (central atom quantity) and s02
!     KJ added 'if' construction and userChLifetime
      iph = 0
      if (userchl) then
         if (userChLifetime.gt.dble(0)) then
            gamach = userChLifetime
         else
            call setgam(iz(iph),ihole,gamach)
            gamach=min(gamach,abs(userChLifetime))
         endif
      else
         call setgam (iz(iph), ihole, gamach)
      endif
      if (s02.eq.1.d0) s02=s02h
      write(slog,*) 'Core hole lifetime set to ',gamach,' eV.'
      call wlog(slog)

!KJ NOW DEAL WITH DIMENSIONS FOR DYNAMICAL ALLOCATION
! These will be written to dimensions.dat using call to WriteDimensions
! Set the appropriate values here :
!   1/ code figures out dimensions to corresponding input options
!   2/ code truncates if 1/ exceeds user limits specified in DIMS card / hardcoded limits in COMMON/m_dimsmod.f90
!   (the DIMS card overrides the values in COMMON/m_dimsmod.f90)

!   1/
      lx=0
      do iph=0,nph
       lx=max(lx,lmaxph(iph))
       lx=max(lx,lmaxsc(iph))
      enddo  

!   1/ :
      rdims=max(rfms1,rfms2,rmax)
      nclusx=0
      do iat = 1, natt
         if (dist(ratx(1,iat),ratx(1,iatabs)).le.rdims) nclusx=nclusx+1
      enddo

!    2/ : happens inside write_dimensions
      call write_dimensions(nclusxuserlimit,lxuserlimit)

!    Now fix lmax values to final lx-value:
      do iph=0,nph
       lmaxph(iph)=min(lx,lmaxph(iph))
       lmaxsc(iph)=min(lx,lmaxsc(iph))
      enddo  

!    Rmax can't really be fixed here since nclusx is a number, not a distance.
!    We must rely on subsequent programs to use nclusx as input and cut off.
!    I.e., lmaxph/sc can be trusted 'blindly' from here on ; but rfms1/2 cannot.

!KJ done with dimensions for dynamical allocation


!KJ   CHECK THAT NO INVALID COMBINATION OF CARDS IS USED :
      call consistency_checker(cards_set)
	  if((cards_set(9) .and. rmax.gt.2.5d0) .and. (cards_set(37) .and. rfms2.gt.2.5d0)) &
	     call wlog("WARNING  It looks like you're trying to use RPATH and FMS in one calculation.  This is syntactically permitted, but almost always a bad idea.  Don't tell us we didn't tell you ...")


!     Convert everything to code units, and use rmult factor
!     rmax is for pathfinder, so leave it in Ang.
      rmax = rmax * rmult
      rfms1 = rfms1 * rmult 
      rfms2 = rfms2 * rmult 
      totvol = totvol * rmult**3
!     Use rmult factor.  Leave distances in Ang.
      do 430  iat = 1, natt
         do 420  i = 1, 3
            ratx(i,iat) = ratx(i,iat) * rmult
  420    continue
  430 continue
      do 460  iph = 0, nph
         do 450  iovr = 1, novr(iph)
            rovr(iovr,iph) = rovr(iovr,iph) * rmult
  450    continue
  460 continue
      do 462  iss = 1, nss
!        rss used only to make paths.dat, so leave it in Angstroms.
         rss(iss) = rss(iss) * rmult
  462 continue

!     Clean up control flags
      if (mpot .ne. 0)  mpot = 1
      if (mphase .ne. 0)  mphase = 1
      if (mfms .ne. 0)  mfms = 1
      if (mpath  .ne. 0)  mpath = 1
      if (mfeff  .ne. 0)  mfeff = 1
      if (mchi   .ne. 0)  mchi = 1
      if (nss    .le. 0)  ms = 1
      if (ifolp  .ne. 0)  iafolp = -1
      if (natt.le.0) then
!       Overalp geometry
        mfms = 0
        mpathold=mpath !KJ 7-06 for writing paths.dat
		! mpath : will path module actually be run?  !KJ
		! mpathold : do we want to create a new list of paths?  !KJ	
        mpath = 0
        ms = 0
!       no SCF loop
        nscmt = 0
        do 464 iph = 0, nph
          if (novr(iph).le.0) call par_stop('Bad OVERLAP cards.')
  464   continue
      endif

      if (iafolp .ge. 0) folp(0:nphx)=folpx

      if (ntitle .le. 0)  then
         ntitle = 1
         title(1) = 'Once upon a time ...' !KJ ;)
      endif
      do i = 1, ntitle
         ltit(i) = istrln (title(i))
      enddo
      nttl = ntitle

!     write atoms.dat, global.inp, modN.inp and ldos.inp
      call wrtall

! Write the dmdw.inp file
      open(unit=65,file='dmdw.inp',status='unknown',iostat=ios)
      if ( Use_DMDW ) then
        write(65,fmt='(i4)') DMDW_Order
        write(65,fmt='(i4,2f11.3)') 1, tk, tk
        write(65,fmt='(i4)') DMDW_Type
        write(65,fmt='(a)') trim(dym_File)
! Now we write the path selectors for the standalone run of the dmdw module
! We will be adding possible choices in the future, maybe make it as
! flexible as the input of dmdw itself.
! Routes:
!     0              Don't do anything
!     1              All SS paths from absorber (assumed to be atom 1, for now)
!     2              Same as 1 + all DS paths
!     3              Same as 2 + all TS paths
!    11              All SS paths
!    12              Same as 1 + all DS paths
!    13              Same as 2 + all TS paths
! NOTE: This is not "pretty" code, will fix later
! Calculate the maximum distance within the input cluster to detemine
! "safe" path cutoffs.
        mxDij2 = 0.0
        do iiAtom = 1,natt-1
          do jjAtom = iiAtom+1,natt
            Dij2 = sum((ratx(:,iiAtom)-ratx(:,jjAtom))**2)
            if ( Dij2 > mxDij2 ) then
              mxDij2 = Dij2
            end if
          end do
        end do
        if ( DMDW_Route == 0 ) then
          write(65,fmt='(i4)')  0
        end if
        if ( DMDW_Route == 1 ) then
          write(65,fmt='(i4)')  1
          write(65,fmt='(3i4,8x,f7.2)') &
                2, 1, 0,       1.1*sqrt(mxDij2)*1.0*1.8897
        end if
        if ( DMDW_Route == 2 ) then
          write(65,fmt='(i4)')  2
          write(65,fmt='(3i4,8x,f7.2)') &
                2, 1, 0,       1.1*sqrt(mxDij2)*1.0*1.8897
          write(65,fmt='(4i4,4x,f7.2)') &
                3, 1, 0, 0,    1.1*sqrt(mxDij2)*2.0*1.8897
        end if
        if ( DMDW_Route == 3 ) then
          write(65,fmt='(i4)')  3
          write(65,fmt='(3i4,8x,f7.2)') &
                2, 1, 0,       1.1*sqrt(mxDij2)*1.0*1.8897
          write(65,fmt='(4i4,4x,f7.2)') &
                3, 1, 0, 0,    1.1*sqrt(mxDij2)*2.0*1.8897
          write(65,fmt='(5i4,   f7.2)') &
                4, 1, 0, 0, 0, 1.1*sqrt(mxDij2)*3.0*1.8897
        end if
        if ( DMDW_Route == 11 ) then
          write(65,fmt='(i4)')  1
          write(65,fmt='(3i4,8x,f7.2)') &
                2, 0, 0,       1.1*sqrt(mxDij2)*1.0*1.8897
        end if
        if ( DMDW_Route == 12 ) then
          write(65,fmt='(i4)')  2
          write(65,fmt='(3i4,8x,f7.2)') &
                2, 0, 0,       1.1*sqrt(mxDij2)*1.0*1.8897
          write(65,fmt='(4i4,4x,f7.2)') &
                3, 0, 0, 0,    1.1*sqrt(mxDij2)*2.0*1.8897
        end if
        if ( DMDW_Route == 13 ) then
          write(65,fmt='(i4)')  3
          write(65,fmt='(3i4,8x,f7.2)') &
                2, 0, 0,       1.1*sqrt(mxDij2)*1.0*1.8897
          write(65,fmt='(4i4,4x,f7.2)') &
                3, 0, 0, 0,    1.1*sqrt(mxDij2)*2.0*1.8897
          write(65,fmt='(5i4,   f7.2)') &
                4, 0, 0, 0, 0, 1.1*sqrt(mxDij2)*3.0*1.8897
        end if
      else
        write(65,fmt='(i4)') -999
      end if
      close(65)

!     In case of OVERLAP and SS calculateions write 'paths.dat'
!     without invoking the pathfinder. Single scattering paths only.
      if (nss .gt. 0  .and.  mpathold .eq. 1)  then !KJ 7-06 : fix bug
         open (unit=1, file='paths.dat', status='unknown', iostat=ios)
         call chopen (ios, 'paths.dat', 'rdinp')
         do 750  i = 1, ntitle
            write(1,748)  title(i)(1:ltit(i))
  748       format (1x, a)
  750    continue
         write(1,751)
  751    format (' Single scattering paths from ss lines cards in feff input')
         write(1,706)
  706    format (1x, 71('-'))
         do 760  iss = 1, nss
            if (rmax.le.0  .or.  rss(iss).le.rmax)  then
!              NB, rmax and rss are in angstroms
               write(1,752) indss(iss), 2, degss(iss), rss(iss)
  752          format ( 2i4, f8.3,'  index,nleg,degeneracy,r=', f8.4)
               write(1,766)
  766          format (' single scattering')
               write(1,754) rss(iss), zero, zero, iphss(iss), potlbl(iphss(iss))
               write(1,753) zero, zero, zero, 0, potlbl(0)
  753          format (3f12.6, i4,  1x, '''', a6, '''', '  x,y,z,ipot')
  754          format (3f12.6, i4,  1x, '''', a6, '''')
            endif
  760    continue
         close (unit=1)
      endif

      do i = 1, ntitle
         call wlog(' ' // title(i)(1:ltit(i)))
      enddo

!     if user doesn't want geom.dat, don't do it
      if (nogeom)  then
!        don't delete geom.dat when done with it either...
         if (ipr4 .lt. 2)  ipr4 = 2
         if (nabs.gt.1) call par_stop('NOGEOM and CFAVERAGE are incompatible')
      else
        iabs = 1
!		!KJ 1-06 : If the user does EELS and doesn't calculate cross terms for an
!       orientation sensitive calculation, FEFF mustn't change the
!       coordinate system, as this would lead to the appearance of
!       cross terms after all.  Therefore, I added an argument to the
!       calling sequence of ffsort.
!       To be precise, giving '.false.' disables the call of ffsort to mkptz.
!       Giving '.true.' makes ffsort work exactly as it always has.
        if((eels.eq.1)) then
           call ffsort(iabs,nss,.false.) !KJ 7-06 added nss
        else
           call ffsort(iabs,nss,.true.) !KJ 7-06 added nss
        endif   !KJ end my changes
       endif
!KJ fix later 8/06 : if spacy=0, ffsort will make path expansion use different coordinates from fms !!
       
       ceels=(eels.eq.1) !KJ 5-6 for monolithic version

  400 call par_barrier
      call par_end

!     sub-program exchange
      call WipeErrorfileAtFinish
      stop
!     return

!     normal end of rdinp

  900 continue
      call wlog(' Error reading input, bad line follows:')
      write(slog,'(1x,a)') line(1:71)
      call wlog(slog)
      call par_stop('RDINP fatal error.')

      end

      subroutine phstop (iph,line)
	  use dimsmod
      implicit double precision (a-h, o-z)
      character*(*) line
      character*512 slog
      if (iph .lt. 0  .or.  iph .gt. nphx)  then
         write(slog,10) iph, nphx, line
         call wlog(slog)
   10    format (' Unique potential index', i5, ' out of range.',       &
     &           ' Must be between 0 and', i5, '.  Input line:',        &
     &           1x, a)
         call par_stop('RDINP - PHSTOP')
      endif
      return
      end


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: chopen.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine chopen (ios, fname, mod)
!     Writes error msg and stops if error in ios flag from open
!     statement.  fname is filename, mod is module with failed open.
      character*(*) fname, mod
      character*512 slog
      external istrln

!     open successful
      if (ios .le. 0)  return

!     error opening file, tell user and die.
      i = istrln(fname)
      j = istrln(mod)
      write(slog,100)  fname(1:i), mod(1:j)
      call wlog(slog)

  100 format (' Error opening file, ', a,                               &
     &        ' in module ', a)

      call wlog(' Fatal error')
      call par_stop('CHOPEN')
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: itoken.f90,v $:
! $Revision: 1.27 $
! $Author: jorissen $
! $Date: 2012/10/23 17:13:13 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      function itoken (word,flname)
!     chars in word assumed upper case, left justified
!     returns 0 if not a token, otherwise returns token

      character*(*) word
      character*4   w
      character*(*) flname
      integer itoken

      w = word(1:4)
      call upper(w)

!     Tokens for feff.inp
!ccccccccccccccccccccccccccccccccccccccccccccccccccccc
      if (flname(1:8).eq.'feff.inp') then
         if     (w .eq. 'ATOM')  then
            itoken = 1
         elseif (w .eq. 'HOLE')  then
            itoken = 2
         elseif (w .eq. 'OVER')  then
            itoken = 3
         elseif (w .eq. 'CONT')  then
            itoken = 4
         elseif (w .eq. 'EXCH')  then
            itoken = 5
         elseif (w .eq. 'ION ')  then
            itoken = 6
         elseif (w .eq. 'TITL')  then
            itoken = 7
         elseif (w .eq. 'FOLP')  then
            itoken = 8
         elseif (w .eq. 'RPAT' .or. w .eq. 'RMAX')  then
            itoken = 9
         elseif (w .eq. 'DEBY')  then
            itoken = 10
         elseif (w .eq. 'RMUL')  then
            itoken = 11
         elseif (w .eq. 'SS  ')  then
            itoken = 12
         elseif (w .eq. 'PRIN')  then
            itoken = 13
         elseif (w .eq. 'POTE')  then
            itoken = 14
         elseif (w .eq. 'NLEG')  then
            itoken = 15
         elseif (w .eq. 'CRIT')  then
            itoken = 16
         elseif (w .eq. 'NOGE')  then
            itoken = 17
         elseif (w .eq. 'IORD')  then
            itoken = 18
         elseif (w .eq. 'PCRI')  then
            itoken = 19
         elseif (w .eq. 'SIG2')  then
            itoken = 20
         elseif (w .eq. 'XANE')  then
            itoken = 21
         elseif (w .eq. 'CORR')  then
            itoken = 22
         elseif (w .eq. 'AFOL')  then
            itoken = 23
         elseif (w .eq. 'EXAF')  then
            itoken = 24
         elseif (w .eq. 'POLA')  then
            itoken = 25
         elseif (w .eq. 'ELLI')  then
            itoken = 26
         elseif (w .eq. 'RGRI')  then
            itoken = 27
         elseif (w .eq. 'RPHA')  then
            itoken = 28
         elseif (w .eq. 'NSTA')  then
            itoken = 29
         elseif (w .eq. 'NOHO')  then
            itoken = 30
         elseif (w .eq. 'SIG3')  then
            itoken = 31
         elseif (w .eq. 'JUMP')  then
            itoken = 32
         elseif (w .eq. 'MBCO')  then
            itoken = 33
         elseif (w .eq. 'SPIN')  then
            itoken = 34
         elseif (w .eq. 'EDGE')  then
            itoken = 35
         elseif (w .eq. 'SCF ')  then
            itoken = 36
         elseif (w .eq. 'FMS ')  then
            itoken = 37
         elseif (w .eq. 'LDOS')  then
            itoken = 38
         elseif (w .eq. 'INTE')  then
            itoken = 39
         elseif (w .eq. 'CFAV')  then
            itoken = 40
         elseif (w .eq. 'S02 ')  then
            itoken = 41
         elseif (w .eq. 'XES ')  then
            itoken = 42
         elseif (w .eq. 'DANE')  then
            itoken = 43
         elseif (w .eq. 'FPRI')  then
            itoken = 44
         elseif (w .eq. 'RSIG')  then
            itoken = 45
         elseif (w .eq. 'XNCD')  then
            itoken = 46
         elseif (w .eq. 'XMCD')  then
            itoken = 46
         elseif (w .eq. 'MULT')  then
            itoken = 47
         elseif (w .eq. 'UNFR')  then
            itoken = 48
         elseif (w .eq. 'TDLD')  then
            itoken = 49
         elseif (w .eq. 'PMBS')  then
            itoken = 50
         elseif (w .eq. 'PLAS' .or. w .eq. 'MPSE')  then
            itoken = 51
         elseif (w .eq. 'SO2C' .or. w .eq. 'SFCO')  then
            itoken = 52
         elseif (w .eq. 'SELF')  then
            itoken = 53
         elseif (w .eq. 'SFSE')  then
            itoken = 54
         elseif (w .eq. 'RCONV') then
            itoken = 55
         elseif (w .eq. 'ELNE') then !KJ new card for EELS 1-06
            itoken = 56
         elseif (w .eq. 'EXEL') then !KJ new card for EELS 1-06
            itoken = 57
         elseif (w .eq. 'MAGI') then !KJ new card for EELS 1-06
            itoken = 58
         elseif (w .eq. 'ABSO') then !KJ new card 3-06
            itoken = 59  
         elseif (w .eq. 'SYMM') then !KJ new card 6-06
            itoken = 60  
         elseif (w .eq. 'REAL') then  !KJ 8/06
              itoken = 61
         elseif (w .eq. 'RECI') then  !KJ 8/06
              itoken = 62
         elseif (w .eq. 'SGRO') then  !KJ 8/06
              itoken = 63
         elseif (w .eq. 'LATT') then  !KJ 8/06
              itoken = 64
         elseif (w .eq. 'KMES') then  !KJ 8/06
              itoken = 65
         elseif (w .eq. 'STRF') then  !KJ 8/06
              itoken = 66
         elseif (w .eq. 'BAND') then  !KJ 8/06
              itoken = 67
         elseif (w .eq. 'CORE') then  !JK 8/09
              itoken = 68
         elseif (w .eq. 'MARK' .or. w .eq. 'TARG') then  !KJ 8/06 !KJ 12-2010
            itoken = 71
         elseif (w .eq. 'EGRI') then  !KJ 1/07
            itoken = 72
         elseif (w .eq. 'COOR') then   !KJ 4/07
            itoken = 73	    
         elseif (w .eq. 'EXTP') then  !JK 4/19/08
            itoken = 74
         elseif (w .eq. 'CHBR') then !JK 4/19/08
            itoken = 75
         elseif (w .eq. 'CHSH') then ! Added by Fer
            itoken = 76
         elseif (w .eq. 'DIMS') then !JPR 4/20/09 renumbered KJ
            itoken = 77
		 elseif (w .eq. 'NRIX') then !KJ 7/09
		    itoken = 78
		 elseif (w .eq. 'LJMA') then !KJ 7/09
		    itoken = 79
		 elseif (w .eq. 'LDEC') then !KJ 7/09
		    itoken = 80
         elseif (w .eq. 'SETE') then ! JJK 1/2010
            itoken = 81
         elseif (w .eq. 'EPS0') then ! JJK 3/2010
            itoken = 82
         elseif (w .eq. 'OPCO') then ! JJK 3/2010
            itoken = 83
         elseif (w .eq. 'NUMD') then ! JJK 3/2010
            itoken = 84
         elseif (w .eq. 'PREP') then ! JJK 3/2010
            itoken = 85 
         elseif (w .eq. 'EGAP') then ! JJK 4/2010
            itoken = 86
         elseif (w .eq. 'CHWI') then ! KJ 6/2010
            itoken = 87 
		 elseif (w .eq. 'MDFF') then ! KJ 11/2010
		    itoken = 88
		 elseif (w .eq. 'REST') then !KJ 12/2010
		    itoken = 89
         elseif (w .eq. 'CONF') then !KJ 12/2010
		    itoken = 90
		 elseif (w .eq. 'SCRE') then !KJ 7/2011
		    itoken = 91
		 elseif (w .eq. 'CIF ') then !KJ 10/2011
		    itoken = 92
		 elseif (w .eq. 'EQUI') then !KJ 1/2012
		    itoken = 93
		 elseif (w .eq. 'COMP') then !BAM 2/2012
		    itoken = 94
		 elseif (w .eq. 'RHOZ') then !BAM 2/2012
		    itoken = 95
		 elseif (w .eq. 'CGRI') then !BAM 2/2012
		    itoken = 96
		 elseif (w .eq. 'CORV') then !KJ 10/2012
		    itoken = 97
         elseif (w .eq. 'END ') then
            itoken = -1            
         else
            itoken = 0
         endif
      elseif (flname(1:10).eq.'spring.inp') then
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
!     These tokens are for spring.inp (input for eq of motion method)
         if (w .eq. 'STRE')  then
            itoken = 1
         elseif (w .eq. 'ANGL')  then
            itoken = 2
         elseif (w .eq. 'VDOS')  then
            itoken = 3
         elseif (w .eq. 'PRDO' .or. w .eq. 'PRIN') then
            itoken = 4
         elseif (w .eq. 'END ')  then
            itoken = -1            
         else
            itoken = 0
         endif
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      endif
      
      
      return
      end



!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: setgam.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine setgam (iz, ihole, gamach)

!     Sets gamach, core hole lifetime.  Data comes from graphs in
!     K. Rahkonen and K. Krause,
!     Atomic Data and Nuclear Data Tables, Vol 14, Number 2, 1974.
!     output gamach is in eV

      implicit double precision (a-h, o-z)

      dimension zh(8,16), gamh(8,16)

      dimension zk(8), gamkp(8)
      parameter (ryd  = 13.605698d0)
      parameter (hart = 2*ryd)
      character*512 slog


!     Note that 0.99 replaces 1.0, 95.1 replaces 95.0 to avoid roundoff
!     trouble.
!     Gam arrays contain the gamma values.
!     We will take log10 of the gamma values so we can do linear
!     interpolation from a log plot.

      data  zh   / 0.99,  10.0, 20.0, 40.0, 50.0, 60.0, 80.0, 95.1,     &
     &              0.99, 18.0, 22.0, 35.0, 50.0, 52.0, 75.0,  95.1,    &
     &              0.99,  17.0, 28.0, 31.0, 45.0, 60.0,  80.0, 95.1,   &
     &              0.99,  17.0, 28.0, 31.0, 45.0, 60.0,  80.0, 95.1,   &
     &              0.99,  20.0, 28.0, 30.0, 36.0, 53.0,  80.0, 95.1,   &
     &              0.99,  20.0, 22.0, 30.0, 40.0, 68.0,  80.0, 95.1,   &
     &              0.99,  20.0, 22.0, 30.0, 40.0, 68.0,  80.0, 95.1,   &
     &              0.99,  36.0, 40.0, 48.0, 58.0, 76.0,  79.0, 95.1,   &
     &              0.99,  36.0, 40.0, 48.0, 58.0, 76.0,  79.0, 95.1,   &
     &              0.99,  30.0, 40.0, 47.0, 50.0, 63.0,  80.0, 95.1,   &
     &              0.99,  40.0, 42.0, 49.0, 54.0, 70.0,  87.0, 95.1,   &
     &              0.99,  40.0, 42.0, 49.0, 54.0, 70.0,  87.0, 95.1,   &
     &              0.99,  40.0, 50.0, 55.0, 60.0, 70.0,  81.0, 95.1,   &
     &              0.99,  40.0, 50.0, 55.0, 60.0, 70.0,  81.0, 95.1,   &
     &              0.99,  71.0, 73.0, 79.0, 86.0, 90.0,  95.0,100.0,   &
     &              0.99,  71.0, 73.0, 79.0, 86.0, 90.0,  95.0,100.0/

      data  gamh / 0.02,  0.28, 0.75,  4.8, 10.5, 21.0, 60.0, 105.0,    &
     &              0.07,  3.9,  3.8,  7.0,  6.0,  3.7,  8.0,  19.0,    &
     &              0.001, 0.12,  1.4,  0.8,  2.6,  4.1,   6.3, 10.5,   &
     &              0.001, 0.12, 0.55,  0.7,  2.1,  3.5,   5.4,  9.0,   &
     &              0.001,  1.0,  2.9,  2.2,  5.5, 10.0,  22.0, 22.0,   &
     &              0.001,0.001,  0.5,  2.0,  2.6, 11.0,  15.0, 16.0,   &
     &              0.001,0.001,  0.5,  2.0,  2.6, 11.0,  10.0, 10.0,   &
     &              0.0006,0.09, 0.07, 0.48,  1.0,  4.0,   2.7,  4.7,   &
     &              0.0006,0.09, 0.07, 0.48, 0.87,  2.2,   2.5,  4.3,   &
     &              0.001,0.001,  6.2,  7.0,  3.2, 12.0,  16.0, 13.0,   &
     &              0.001,0.001,  1.9, 16.0,  2.7, 13.0,  13.0,  8.0,   &
     &              0.001,0.001,  1.9, 16.0,  2.7, 13.0,  13.0,  8.0,   &
     &              0.001,0.001, 0.15,  0.1,  0.8,  8.0,   8.0,  5.0,   &
     &              0.001,0.001, 0.15,  0.1,  0.8,  8.0,   8.0,  5.0,   &
     &              0.001,0.001, 0.05, 0.22,  0.1, 0.16,   0.5,  0.9,   &
     &              0.001,0.001, 0.05, 0.22,  0.1, 0.16,   0.5,  0.9/

!     Since feff8 can be called any number of times . ALA

      if (ihole .le. 0)  then
         gamach = 0
         write(slog,'(a,1pe13.5)') ' No hole in SETGAM, gamach = ',     &
     &                             gamach
         call wlog(slog)
         return
      endif
      if (ihole .gt. 16)  then
         call wlog(' This version of FEFF will set gamach = 0.1 eV ' // &
     &             ' for O1 and higher hole')
         call wlog(' You can use CORRECTIONS card  to set ' //          &
     &   ' gamach = 0.1 + 2*vicorr ')
!        stop 'SETGAM-2'
      endif

      zz = iz
      if (ihole .le. 16)  then
         do 10  i = 1, 8
            gamkp(i) = log10 (gamh(i,ihole))
            zk(i) = zh(i,ihole)
   10    continue
         call terp (zk, gamkp, 8, 1, zz, gamach)
      else
!     include data from the tables later.
!     Now gamach=0.1eV for any O-hole for any element.
         gamach = -1.0
      endif

!     Change from log10 (gamma) to gamma
      gamach = 10.0 ** gamach


      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: str.f90,v $:
! $Revision: 1.4 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! FUNCTION ISTRLN (STRING)  Returns index of last non-blank
!                           character.  Returns zero if string is
!                           null or all blank.

      FUNCTION ISTRLN (STRING)
      CHARACTER*(*)  STRING
      CHARACTER BLANK, TAB
      PARAMETER (BLANK = ' ', TAB = '	')
!     there is a tab character here  ^

!  -- If null string or blank string, return length zero.
      ISTRLN = 0
      IF (STRING (1:1) .EQ. CHAR(0))  RETURN
      IF (STRING .EQ. ' ')  RETURN

!  -- Find rightmost non-blank character.
      ILEN = LEN (STRING)
      DO 20  I = ILEN, 1, -1
         IF (STRING(I:I).NE.BLANK .AND. STRING(I:I).NE.TAB)  GOTO 30
   20 CONTINUE
   30 ISTRLN = I

      RETURN
      END
! SUBROUTINE TRIML (STRING)  Removes leading blanks.

      SUBROUTINE TRIML (STRING)
      CHARACTER*(*)  STRING
      CHARACTER*512  TMP !KJ 7-09 increased from 200 to 512.  Would prefer a more dynamic solution FIX LATER.  Important for header feff.bin
      CHARACTER BLANK, TAB
      PARAMETER (BLANK = ' ', TAB = '	')
!     there is a tab character here  ^

      JLEN = ISTRLN (STRING)

!  -- All blank and null strings are special cases.
      IF (JLEN .EQ. 0)  RETURN

!  -- FInd first non-blank char
      DO 10  I = 1, JLEN
         IF (STRING(I:I).NE.BLANK .AND. STRING(I:I).NE.TAB)  GOTO 20
   10 CONTINUE
   20 CONTINUE

!  -- If I is greater than JLEN, no non-blanks were found.
      IF (I .GT. JLEN)  RETURN

!  -- Remove the leading blanks.
      TMP = STRING (I:)
      STRING = TMP
      RETURN
      END
! SUBROUTINE UPPER (STRING)  Changes a-z to upper case.

      SUBROUTINE UPPER (STRING)
      CHARACTER*(*)  STRING

      JLEN = ISTRLN (STRING)

      DO 10  I = 1, JLEN
         IC = ICHAR (STRING (I:I))
         IF ((IC .LT. 97)  .OR.  (IC .GT. 122))  GOTO 10
         STRING (I:I) = CHAR (IC - 32)
   10 CONTINUE

      RETURN
      END
! SUBROUTINE LOWER (STRING)  Changes A-Z to lower case.

      SUBROUTINE LOWER (STRING)
      CHARACTER*(*)  STRING

      JLEN = ISTRLN (STRING)

      DO 10  I = 1, JLEN
         IC = ICHAR (STRING (I:I))
         IF ((IC .LT. 65) .OR.  (IC .GT. 90))  GOTO 10
         STRING (I:I) = CHAR (IC + 32)
   10 CONTINUE

      RETURN
      END
!***********************************************************************
!
      SUBROUTINE BWORDS (S, NWORDS, WORDS)
!
!     Breaks string into words.  Words are seperated by one or more
!     blanks or tabs, or a comma and zero or more blanks.
!
!     ARGS        I/O      DESCRIPTION
!     ----        ---      -----------
!     S            I       CHAR*(*)  String to be broken up
!     NWORDS      I/O      Input:  Maximum number of words to get
!                          Output: Number of words found
!     WORDS(NWORDS) O      CHAR*(*) WORDS(NWORDS)
!                          Contains words found.  WORDS(J), where J is
!                          greater then NWORDS found, are undefined on
!                          output.
!
!      Written by:  Steven Zabinsky, September 1984
!      Tab char added July 1994.
!
!**************************  Deo Soli Gloria  **************************

!  -- No floating point numbers in this routine.
      IMPLICIT INTEGER (A-Z)

      CHARACTER*(*) S, WORDS(NWORDS)

      CHARACTER BLANK, COMMA, TAB
      PARAMETER (BLANK = ' ', COMMA = ',', TAB = '	')
!     there is a tab character here               ^.

!  -- BETW    .TRUE. if between words
!     COMFND  .TRUE. if between words and a comma has already been found
      LOGICAL BETW, COMFND

!  -- Maximum number of words allowed
      WORDSX = NWORDS

!  -- SLEN is last non-blank character in string
      SLEN = ISTRLN (S)
!  -- All blank string is special case
      IF (SLEN .EQ. 0)  THEN
         NWORDS = 0
         RETURN
      ENDIF

!  -- BEGC is beginning character of a word
      BEGC = 1
      NWORDS = 0

      BETW   = .TRUE.
      COMFND = .TRUE.

      DO 10  I = 1, SLEN
         IF (S(I:I) .EQ. BLANK .OR. S(I:I) .EQ. TAB)  THEN
            IF (.NOT. BETW)  THEN
               NWORDS = NWORDS + 1
               WORDS (NWORDS) = S (BEGC : I-1)
               BETW = .TRUE.
               COMFND = .FALSE.
            ENDIF
         ELSEIF (S(I:I) .EQ. COMMA)  THEN
            IF (.NOT. BETW)  THEN
               NWORDS = NWORDS + 1
               WORDS (NWORDS) = S(BEGC : I-1)
               BETW = .TRUE.
            ELSEIF (COMFND)  THEN
               NWORDS = NWORDS + 1
               WORDS (NWORDS) = BLANK
            ENDIF
            COMFND = .TRUE.
         ELSE
            IF (BETW)  THEN
               BETW = .FALSE.
               BEGC = I
            ENDIF
         ENDIF

         IF (NWORDS .GE. WORDSX)  RETURN

   10 CONTINUE

      IF (.NOT. BETW  .AND.  NWORDS .LT. WORDSX)  THEN
         NWORDS = NWORDS + 1
         WORDS (NWORDS) = S (BEGC :SLEN)
      ENDIF

      RETURN
      END

!***********************************************************************
!
      SUBROUTINE BWORDS2 (S, NWORDS, WORDS)
!
!     Breaks string into words.  Words are seperated by one or more
!     blanks or tabs.
!
!     ARGS        I/O      DESCRIPTION
!     ----        ---      -----------
!     S            I       CHAR*(*)  String to be broken up
!     NWORDS      I/O      Input:  Maximum number of words to get
!                          Output: Number of words found
!     WORDS(NWORDS) O      CHAR*(*) WORDS(NWORDS)
!                          Contains words found.  WORDS(J), where J is
!                          greater than NWORDS found, are undefined on
!                          output.
!
!      Written by:  Steven Zabinsky, September 1984
!      Tab char added July 1994.
!
!**************************  Deo Soli Gloria  **************************

!  -- No floating point numbers in this routine.
      IMPLICIT INTEGER (A-Z)

      CHARACTER*(*) S, WORDS(NWORDS)

      CHARACTER BLANK, COMMA, TAB
      PARAMETER (BLANK = ' ', TAB = '	')
!     there is a tab character here               ^.

!  -- BETW    .TRUE. if between words
!     COMFND  .TRUE. if between words and a comma has already been found
      LOGICAL BETW, COMFND

!  -- Maximum number of words allowed
      WORDSX = NWORDS

!  -- SLEN is last non-blank character in string
      SLEN = ISTRLN (S)

!  -- All blank string is special case
      IF (SLEN .EQ. 0)  THEN
         NWORDS = 0
         RETURN
      ENDIF

!  -- BEGC is beginning character of a word
      BEGC = 1
      NWORDS = 0

      BETW   = .TRUE.
      COMFND = .TRUE.

      DO 10  I = 1, SLEN
         IF (S(I:I) .EQ. BLANK .OR. S(I:I) .EQ. TAB)  THEN
            IF (.NOT. BETW)  THEN
               NWORDS = NWORDS + 1
               WORDS (NWORDS) = S (BEGC : I-1)
               BETW = .TRUE.
               COMFND = .FALSE.
            ENDIF
         ELSE
            IF (BETW)  THEN
               BETW = .FALSE.
               BEGC = I
            ENDIF
         ENDIF

         IF (NWORDS .GE. WORDSX)  RETURN

   10 CONTINUE

      IF (.NOT. BETW  .AND.  NWORDS .LT. WORDSX)  THEN
         NWORDS = NWORDS + 1
         WORDS (NWORDS) = S (BEGC :SLEN)
      ENDIF
 
      RETURN
      END


      SUBROUTINE UNTAB (STRING)
! REPLACE TABS WITH BLANKS :    TAB IS ASCII DEPENDENT
      INTEGER        ITAB , I, ILEN, ISTRLN
      PARAMETER      (ITAB = 9)
      CHARACTER*(*)  STRING, TAB*1
      EXTERNAL ISTRLN
      TAB  = CHAR(ITAB)
      ILEN = MAX(1, ISTRLN(STRING))
 10   CONTINUE 
        I = INDEX(STRING(:ILEN), TAB ) 
        IF (I .NE. 0) THEN
            STRING(I:I) = ' '
            GO TO 10
        END IF
      RETURN
! END SUBROUTINE UNTAB
      END

      logical function iscomm (line)
!     returns true if line is a comment or blank line, false otherwise
!#mn{ rewritten to allow ";*%#" as comment characters
       character*(*) line
       iscomm = ((line.eq.' ').or.(index(';*%#',line(1:1)).ne.0))
!#mn}
      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: wlog.f90,v $:
! $Revision: 1.4 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine wlog (string)
      use par
      character*(*) string
      integer istrln
      external istrln

!     This output routine is used to replace the PRINT statement
!     for output that "goes to the terminal", or to the log file.
!     If you use a window based system, you can modify this routine
!     to handle the running output elegantly.
!     Handle carriage control in the string you pass to wlog.
!
!     The log file is also written here, hard coded here.

!     The log file is unit 11.  The log file is opened in the
!     main program, program feff.

!     make sure not to write trailing blanks

   10 format (a)

!     Suppress output in sequential loops
      if (par_type .eq. 2) return

      il = istrln (string)
      if (il .eq. 0)  then
         print 10
         if (par_type .ne. 3) write(11,10)
      else
         print 10, string(1:il)
         if (par_type .ne. 3) write(11,10) string(1:il)
      endif
      return
      end
      subroutine lblank (string)
      character*(*) string
!     add a leading blank, useful for carriage control
      string = ' ' // string
      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: dist.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      double precision function dist (r0, r1)
!     find distance between cartesian points r0 and r1
      implicit double precision (a-h, o-z)
      dimension r0(3), r1(3)
      dist = 0
      do 10  i = 1, 3
         dist = dist + (r0(i) - r1(i))**2
   10 continue
      dist = sqrt (dist)
      return
      end

!  **************************************************
!  Parallel feff8 routines
!  Jim Sims
!  **************************************************

      subroutine par_begin
!  **************************************************
!  Initializations for parallel version(s)
!  **************************************************

      use par

!-- So cvd or dbx can attach to a running process
!     call sleep(30) 

      numprocs = 1
      my_rank = 0
      this_process = my_rank

      par_type = 0
      parallel_run = .false.
!-- The following variable will be used for IO that should only be
!-- done in one process.
      master = (my_rank .eq. 0)

      worker = (.not. master)
      if (worker) par_type = 1

      return
      end

      subroutine par_stop (string)
!  **************************************************
!  Abnormal termination of the parallel session
!  **************************************************
      use par
!     For abnormal exits 
!     If open, close unit = 11
!     Go to the barrier that workers are sitting at
!     Then everyone will call par_end and stop
      logical is_open
      character*(*) string

      inquire(unit=11,opened=is_open)
      if (is_open) then
        call wlog(string)
        close(unit=11)
      else if (string .ne. ' ') then
        print *,string
        print *,'Abnormal termination on processor ',this_process
      endif

      stop ' '
      end

      subroutine par_end
!  **************************************************
!  Terminate the parallel session
!  **************************************************
      return
      end

      subroutine par_barrier
!  **************************************************
!  Calls mpi_barrier
!  **************************************************
      return
      end

      subroutine par_send_int(buf,count,dest,tag)
!  **************************************************
!  Call mpi_send for integer arrays
!  **************************************************
      integer count,dest,tag
      integer buf(*)
      return
      end

      subroutine par_send_int_scalar(buf,count,dest,tag)
!  **************************************************
!  Call mpi_send for integer arrays
!  **************************************************
      integer count,dest,tag
      integer buf
      return
      end


      subroutine par_send_cmplx(buf,count,dest,tag)
!  **************************************************
!  Call mpi_send for complex arrays
!  **************************************************
      integer count,dest,tag
      complex buf(*)
      return
      end

      subroutine par_send_real(buf,count,dest,tag)
!  **************************************************
!  Call mpi_send for real arrays
!  **************************************************
      integer count,dest,tag
      real buf(*)
      return
      end

      subroutine par_send_dc(buf,count,dest,tag)
!  **************************************************
!  Call mpi_send for double_complex arrays
!  **************************************************
      integer count,dest,tag
      complex*16 buf(*)
      return
      end

      subroutine par_recv_int(buf,count,source,tag)
!  **************************************************
!  Call mpi_recv for integer arrays
!  **************************************************
      integer count,source,tag
      integer buf(*)
      return
      end

      subroutine par_recv_int_scalar(buf,count,source,tag)
!  **************************************************
!  Call mpi_recv for integer arrays
!  **************************************************
      integer count,source,tag
      integer buf
      return
      end

      subroutine par_recv_cmplx(buf,count,source,tag)
!  **************************************************
!  Call mpi_recv for complex arrays
!  **************************************************
      integer count,source,tag
      complex buf(*)
      return
      end

      subroutine par_recv_real(buf,count,source,tag)
!  **************************************************
!  Call mpi_recv for real arrays
!  **************************************************
      integer count,source,tag
      real buf(*)
      return
      end

      subroutine par_recv_dc(buf,count,source,tag)
!  **************************************************
!  Call mpi_recv for double complex arrays
!  **************************************************
      integer count,source,tag
      complex*16 buf(*)
      return
      end

      subroutine par_bcast_int(buf,count,source)
!  **************************************************
!  Call mpi_bcast for integer arrays
!  **************************************************
      integer count,source
      integer buf(*)
      return
      end

      subroutine par_bcast_cmplx(buf,count,source)
!  **************************************************
!  Call mpi_bcast for complex arrays
!  **************************************************
      integer count,source
      complex buf(*)
      return
      end

      subroutine par_bcast_real(buf,count,source)
!  **************************************************
!  Call mpi_bcast for real arrays
!  **************************************************
      integer count,source
      real buf(*)
      return
      end

      subroutine par_bcast_dc(buf,count,source)
!  **************************************************
!  Call mpi_bcast for double_complex arrays
!  **************************************************
      integer count, source
      complex*16 buf(*)
      return
      end

      subroutine MPE_DECOMP1D( n, num_procs, myid, s, e )
!  ******************************************************
!  A routine for producing a decomposition of a 1-d 
!  array when given a number of processors.  It may 
!  be used in "direct" product decomposition.  The 
!  values returned assume a "global" domain in [1:n]
!  ******************************************************
!  MPE_Decomp1d - Compute a balanced decomposition of
!  a 1-D array
!  ******************************************************
!  Input Parameters:
!  n  - Length of the array
!  num_procs - Number of processors in decomposition
!  myid  - Rank of this processor in the decomposition 
!  (0 <= rank < size)
!  ******************************************************
!  Output Parameters:
!  s,e - Array my_particles are s:e, with the original 
!  array considered as 1:n.  
!  ******************************************************

      integer n, num_procs, myid, s, e
      integer nloc, deficit
 
      nloc  = n / num_procs
      s       = myid * nloc + 1
      deficit = mod(n,num_procs)
      s       = s + min(myid,deficit)
      if (myid .lt. deficit) then
        nloc = nloc + 1
      endif
      e = s + nloc - 1
      if (e .gt. n .or. myid .eq. num_procs-1) e = n

      return
      end

      SUBROUTINE SECONDS( W)
!  ***************************************************
!  SECONDS returns the wall clock times for a process
!  in seconds.
!  ***************************************************
 
      REAL*8      W

      W = 0.0

      RETURN
      END

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: consistency.f90,v $:
! $Revision: 1.14 $
! $Author: jorissen $
! $Date: 2012/03/27 18:15:07 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine consistency_checker(c)
! Added KJ 7-09
! This routine knows which cards have been read from feff.inp by looking at the c array.
! It checks for invalid combinations, eg. two incompatible cards specified, or a missing required card.

! Since we now have so many cards, it would be good to have all these "rules" in one place.
! Also, this setup should be easy to port into the GUI.
! More sophisticated checks (eg. dependent on value of a given card option) should still be done in rdinp.f90


      implicit none
	  logical,intent(in) :: c(100)
!     "c" keeps track of whether a card was listed in feff.inp or no.
!     Check that no incompatible combinations exist.
      integer i(100)
	  integer j
      CHARACTER messg(300)

!     set up equivalent array i - integers easier to check groups of exclusive cards
      i=0
      do j=1,100
	     if (c(j)) i(j)=1
	  enddo


!  1/ Not more than one spectroscopy selected (only 1 choice of exafs,exelfs,xanes,elnes,xes,danes,fprime)
      if(i(21)+i(24)+i(42)+i(43)+i(44)+i(56)+i(57).gt.1) stop 'ERROR more than one type of spectroscopy selected'
!  2/ Nrixs must be combined with XANES or EXAFS, but no other card
      if(c(78).and.(i(21)+i(24).ne.1)) stop 'NRIXS must be combined with XANES or EXAFS'
	  if(c(78).and.(i(42)+i(43)+i(44)+i(56)+i(57).gt.0)) stop 'NRIXS combined with incompatible spectroscopy card'	        
!  3/ NRIXS check 2 : This may be overly conservative but I'm worried about overlap and reuse of le2 MULTIPOLE <-> LJMAX
      if((c(79).or.c(80)).and.(.not.c(78))) stop 'LDEC and LJMAX cards only allowed with NRIXS'
      if(c(78).and.c(47)) stop 'you cannot combine NRIXS and MULTIPOLE'
!  4/ NRIXS check 3 :
      if(c(78).and.(i(25)+i(26)+i(29)+i(34)+i(40)+i(46)+i(28)+i(42)+i(49)+i(50).gt.0)) then
         
         messg = 'The following cards explicitly forbidden for NRIXS : ' // &
      &       'ELLIP,POLARIZATION,NSTAR,SPIN,CFAVERAGE,XNCD,XMCD,RPHASES,TDLDA,XES,PMBSE'
         stop
      end if
!  5/ k-space needs lattice vectors and k-mesh
      if(c(62)) then
	     if (((i(65)+i(71)).ne.2)) stop 'KMESH and TARGET are required for RECIPROCAL card'
		 if ((i(64)+i(92)).ne.1) stop 'use either LATTICE or CIF with RECIPROCAL card'
	  endif
!  6/ NOHOLE card and COREHOLE card do the same things. JK 08/09
      if(c(30).and.c(68)) stop 'Please use only one of the NOHOLE and COREHOLE cards. They are redundant.'

!!  7/ MDFF needs ELNES or EXELFS
!      if(c(88).and.(.not.(c(56).or.c(57)))) stop 'MDFF must be used with ELNES or EXELFS.'


!  8/ No COMPTON options if compton not enabled
	  if((.not.(c(94).or.c(95))) .and. c(96)) stop 'Cannot use CGRID without COMPTON or RHOZZP.  Exiting.'

!!! Everybody please add their own checks!




      return
	  end
!     Copied from COMMON/itoken.f90 on 7-09 :
! ATOM = 1
! HOLE = 2
! OVER = 3
! CONT = 4
! EXCH = 5
! ION  = 6
! TITL = 7
! FOLP = 8
! RPAT/RMAX = 9
! DEBY = 10
! RMUL = 11
! SS =   12
! PRIN = 13
! POTE = 14
! NLEG = 15
! CRIT = 16
! NOGE = 17
! IORD = 18
! PCRI = 19
! SIG2 = 20
! XANE = 21
! CORR = 22
! AFOL = 23
! EXAF = 24
! POLA = 25
! ELLI = 26
! RGRI = 27
! RPHA = 28
! NSTA = 29
! NOHO = 30
! SIG3 = 31
! JUMP = 32
! MBCO = 33
! SPIN = 34
! EDGE = 35
! SCF  = 36
! FMS  = 37
! LDOS = 38
! INTE = 39
! CFAV = 40
! S02  = 41
! XES  = 42
! DANE = 43
! FPRI = 44
! RSIG = 45
! XNCD = 46
! XMCD = 46
! MULT = 47
! UNFR = 48
! TDLD = 49
! PMBS = 50
! PLAS = 51
! SO2C = 52
! SELF = 53
! SFSE = 54
! RCONV = 55
! ELNE = 56
! EXEL = 57
! MAGI = 58
! ABSO = 59
! SYMM = 60
! REAL = 61
! RECI = 62
! SGRO = 63
! LATT = 64
! KMES = 65
! STRF = 66
! BAND = 67
! TARG = 71
! EGRI = 72
! COOR = 73	
! EXTP = 74
! CHBR = 75
! CHSH = 76
! DIMS = 77
! NRIX = 78
! LJMA = 79
! LDEC = 80

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: ffsort.f90,v $:
! $Revision: 1.7 $
! $Author: jorissen $
! $Date: 2010/11/30 19:41:54 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine ffsort (iabs,nss,doptz)
! KJ 1-06 : I added second input argument doptz
! KJ 7-06 : I added third input argument nss      

!     finds iabs-th atom of 'iphabs' type in file atoms.dat and writes
!     a smaller list of all atoms within 'rclabs' of that particular
!     absorber into 'geom.dat' file.
!      first coded by a.l.ankudinov, 1998 for CFAVERAGE card
!      modified by a.l.ankudinov, march 2001 for new i/o structure

      use par
	  use constants
	  use dimsmod
	  use geometry_inp
	  use global_inp
	  use potential_inp,only: iz
      implicit double precision (a-h, o-z)

!c    INPUT
      integer iabs
      logical,intent(in) :: doptz  !KJ 1-06 : call mkptz or not?
      integer,intent(in):: nss !KJ 7-06 : for sanity check at bottom of file	
!c    OUTPUT: geom.dat
      integer  nat
      integer iatph(0:nphx), iphat(natx), index(natx)
      double precision  rat(3,natx)

!     Local stuff
      real*8,parameter :: big = 1.0e5
      character*512 slog
	  integer iz1,iz2

      external dist

!     standard formats for string, integers and real numbers
  10  format(a)
  20  format (20i4)
  30  format (6f13.5)
  45  format ( 2i8, f13.5)
  50  format ( 3i5, 2f12.4, i5) !KJ

!     Find the first absorber (iphabs type) in a long list (iabs.le.0),
!     or find iabs-th atom in the list of type iphabs (iabs.gt.0)
      iatabs = 0
      icount = 0
      ifound = 0
      do iat = 1, natt
         if (iphatx(iat) .eq. 0) iphatx(iat) = iphabs
         if (iphatx(iat) .eq. iphabs) icount = icount +1
         if (ifound.eq.0 .and. icount.gt.0 .and. (icount.eq.iabs .or.   &
     &                          (iabs.le.0 .and. icount.eq.1))) then
            iatabs = iat
            ifound =1
         endif
      enddo

!     Make several sanity checks
      if (iatabs.eq.0 .and. natt.gt.1) then
         call wlog(' No absorbing atom (unique pot 0 or iphabs in CFAVERAGE  card) was defined.')
         call par_stop('RDINP')
      endif
      if (iphabs.eq.0 .and. icount.gt.1) then
         call wlog(' More than one absorbing atom (potential 0)')
         call wlog(' Only one absorbing atom allowed')
         call par_stop('RDINP')
      endif
      if ((icount.gt.0 .and. icount.lt.nabs) .or. nabs.le.0) then
         nabs = icount
         call wlog(' Averaging over ALL atoms of iphabs type')
      endif

!     Make absorbing atom first in the short list
      if (iatabs .ne. 0) then
         rat(:,1) = 0
         iphat(1) = 0
         index(1) = iatabs
      endif
          
!     make a smaller list of atoms from a big one
      nat = 1
      do iat = 1,natt
         if (iat.ne.iatabs) then
            tmp = dist (ratx(1,iat), ratx(1,iatabs))
            if (tmp.gt.0.1 .and. tmp.le.rclabs) then
               nat = nat + 1
               if (nat.gt.natx) then
                 write (slog, 307) nat, natx
  307            format (' Number of atoms', i6, 'exceeds max allowed for the pathfinder =', i6)
                 call wlog (' Use or reduce rclabs in CFAVERAGE card')
                 call wlog (' Or increase parameter natx and recompile')
                 call par_stop('RDINP')
               endif
               rat(1,nat) = ratx(1,iat)-ratx(1,iatabs)
               rat(2,nat) = ratx(2,iat)-ratx(2,iatabs)
               rat(3,nat) = ratx(3,iat)-ratx(3,iatabs)
               iphat(nat) = iphatx(iat)
               index(nat) = iat
            endif
         endif
      enddo
!     sort atoms by distance
      do 315 iat = 1,nat-1
        r2min = rat(1,iat)**2 + rat(2,iat)**2 + rat(3,iat)**2
        imin = iat
        do 310 i = iat+1,nat
          r2 = rat(1,i)**2 + rat(2,i)**2 + rat(3,i)**2
          if (r2.lt.r2min) then
            r2min = r2
            imin = i
          endif
 310    continue
        if (imin.ne.iat) then
!         permute coordinates for atoms iat and imin
          do 311 i = 1,3
            r2 = rat(i,iat)
            rat(i,iat) = rat(i,imin)
            rat(i,imin) = r2
 311      continue
          i = iphat(iat)
          iphat(iat) = iphat(imin)
          iphat(imin) = i
          i = index(iat)
          index(iat) = index(imin)
          index(imin) = i
        endif
 315  enddo


!KJ 7-09 NOTE : Aleksi added following comment here in feff8q, which I don't understand :
!c     Bogus comment below. q-vector along z-axis and "polarization" along x+y vector. Not really used. 


!     rotate xyz frame for the most convenience and make polarization tensor
!     make polarization tensor when z-axis is along k-vector 
      if (doptz) call mkptz(nat,rat) !KJ I added the if-statement 1-06
!     rewrite global.inp for initial iteration to update 'ptz'
        call global_write(.false.) !Don't recalculate the norm of vectors - they're lost, since mkptz normalized everything ...

!     Find model atoms for unique pots that have them
!     Use atom closest to absorber for model
      do 316  iph = 1, nphx
 316  iatph(iph) = 0
!     By construction absorbing atom is first in the list
      iatph(0) = 1
      nph = 0
      do 330  iph = 1, nphx
         rabs = big
         do 320  iat = 2, nat
            if (iph .eq. iphat(iat))  then
               tmp = dist (rat(1,iat), rat(1,1))
               if (tmp .lt. rabs)  then
!                 this is the closest so far
                  rabs = tmp
                  iatph(iph) = iat
               endif
            endif
  320    continue
         if (iatph(iph).gt.0) nph = iph
  330 continue
!     if iatph > 0, a model atom has been found.

!     Check if 2 atoms are closer together than 1.75 bohr (~.93 Ang)
      ratmin = 1.0e20
      do 480  iat = 1, nat
         do 470  jat = iat+1, nat
            rtmp = dist(rat(1,iat),rat(1,jat))
            if (rtmp .lt. ratmin)  ratmin = rtmp
            if (rtmp .lt. 1.75 * bohr)  then
			
               iatx = index(iat)
               jatx = index(jat)
			   iz1=iz(iphat(iatx))
			   iz2=iz(iphat(jatx))
			   if(iz1.ne.1 .or. iz2.ne.1 .or. rtmp.lt. 0.70) then
			      !KJ 11/2010:
				  ! added distance and atomic number to warning message (duh)
				  ! separate threshold for H-H bond (which is 0.74A = 1.4 bohr long)
                  call wlog(' :WARNING  TWO ATOMS VERY CLOSE TOGETHER. CHECK INPUT.')
                  write(slog,'(a,2i8,a,e13.5,a)') ' atoms ', iatx, jatx,' distance ',rtmp,' Angstrom'
                  call wlog(slog)
                  write(slog,'(i5,1p,3e13.5,a,i4)') iatx, (ratx(i,iatx),i=1,3), ' Z=',iz(iphat(iatx))
                  call wlog(slog)
                  write(slog,'(i5,1p,3e13.5,a,i4)') jatx, (ratx(i,jatx),i=1,3), ' Z=',iz(iphat(jatx))
                  call wlog(slog)
               endif
            endif
  470    continue
  480 continue

!     Write output geom.dat
      open (file='geom.dat', unit=3, status='unknown',iostat=ios)
        write (3,535) nat, nph
  535   format ('nat, nph = ', 2i5)
        write (3,516) (iatph(iph), iph=0,nph)
  516   format(16i5)
        write (3, 10) ' iat     x       y        z       iph  '
        write (3, 526)
  526   format (1x, 71('-'))
        ibounc = 1
        do 540  i = 1, nat
          write(3,536) i, rat(1,i), rat(2,i), rat(3,i), iphat(i), ibounc
  536     format(i4, 3f13.5, 2i4)
  540   continue
      close(3)

!     Atoms for the pathfinder
      if (iatabs.le.0 .and. nss.le.0 .and. nat.gt.0 )  then !KJ 7-06 added second and third condition
         call wlog(' Absorbing atom coords not specified.')
         call wlog(' Cannot find multiple scattering paths.')
         call par_stop('RDINP')
      endif

! 400 call par_barrier

      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: fixlinenow.f90,v $:
! $Revision: 1.5 $
! $Author: jorissen $
! $Date: 2012/09/04 23:15:20 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine fixlinenow(w,nw)
      use dimsmod,only:nwordx
      implicit none 
!      integer nwordx     
!      parameter (nwordx = 20)
      character*120 w(nwordx),k  !KJ 9-2012 raised 20->120 in accordance with rdinp.f90 .  Solved some bugs.
      integer nw,nwold,i
      logical iscomm
      external iscomm
 
      nwold=nw
      do i=1,nw
        k=w(i)
        call untab(k)
        call triml(k)
        w(i)=k
!	write(*,'(a1,a20,a1,i1)') '-',w(i),'-',iscomm(w(i))
        if (iscomm(w(i))) then
          nw=i-1
          exit
        endif
      enddo
      
      if (nw.ne.nwold) then
        do i=nw+1,nwold
        
          w(i)='                    '
        enddo
      endif
      
      
      return
      end
      


subroutine importcif(cifname,cif_equivalence)

! This routine opens a .cif file (Crystallographic Information File).
! It then extracts the information needed to set up a k-space FEFF9 calculation.
! ciftbx v.4 is used for the manipulation of the .cif file.
! The second part of the routine reworks the info from the .cif file to the right format.
use dimsmod,only: nphx
use struct,only:  m_a1=>a1,m_a2=>a2,m_a3=>a3,m_alat=>alat,m_alfalat=>alfalat,m_sgroup=>sgroup,m_nats=>nats,m_nph=>nph,m_natom=>natom,m_latticename=>latticename,&
   m_ppos=>ppos,m_ppot=>ppot,m_absorber=>absorber,m_lpot=>lpot,m_nsp=>nsp,m_celvol=>celvol,m_cryst_gr=>cryst_gr,m_nsym=>nsym,m_sgroup_hm=>sgroup_hm,m_lattice=>lattice,&
   m_label=>label,m_izatom=>izatom,m_firstpos=>firstpos,&
   m_init_struct=>init_struct  !contains the k-space variables specifying the structure
implicit none
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmn 

!
! >>>>>> Common and Function declararations 'ciftbx.cmn'
!
!        These declarations must be included in ciftbx user
!        applications.
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmf 
!
! >>>>>> Function declararations 'ciftbx.cmf'
!
!
!        These external declarations are needed to complete
!        the user definitions in ciftbx.cmn
!           
!
!                                 Logical function init_
         logical   init_
!                                 Logical function dict_
         logical   dict_
!                                 Logical function ocif_
         logical   ocif_
!                                 Logical function data_
         logical   data_
!                                 Logical function dtype_
         logical   dtype_
!                                 Logical function test_
         logical   test_
!                                 Logical function bkmrk_
         logical   bkmrk_
!                                 Logical function find_
         logical   find_
!                                 Logical function name_
         logical   name_
!                                 Logical function numb_
         logical   numb_
!                                 Logical function numd_
         logical   numd_
!                                 Logical function char_
         logical   char_
!                                 Logical function charnp_
         logical   charnp_
!                                 Logical function cmnt_
         logical   cmnt_
!                                 Logical function cotd_
         logical   cotd_
!                                 Logical function cotdb_
         logical   cotdb_
!                                 Logical function delim_
         logical   delim_
!                                 Logical function pfile_
         logical   pfile_
!                                 Logical function pdata_
         logical   pdata_
!                                 Logical function pchar_
         logical   pchar_
!                                 Logical function pcmnt_
         logical   pcmnt_
!                                 Logical function pdelim_
         logical   pdelim_
!                                 Logical function pnumb_
         logical   pnumb_
!                                 Logical function pnumd_
         logical   pnumd_
!                                 Logical function ptext_
         logical   ptext_
!                                 Logical function ploop_
         logical   ploop_
!                                 Logical function prefx_
         logical   prefx_
!
!                                 logical function init_
         external   init_
!                                 logical function dict_
         external   dict_
!                                 logical function ocif_
         external   ocif_
!                                 logical function data_
         external   data_
!                                 Logical function dtype_
         external   dtype_
!                                 logical function delim_
         external   delim_
!                                 logical function test_
         external   test_
!                                 logical function bkmrk_
         external   bkmrk_
!                                 logical function find_
         external   find_
!                                 logical function name_
         external   name_
!                                 logical function numb_
         external   numb_
!                                 logical function numd_
         external   numd_
!                                 logical function char_
         external   char_
!                                 logical function charnp_
         external   charnp_
!                                 logical function cmnt_
         external   cmnt_
!                                 logical function cotd_
         external   cotd_
!                                 logical function cotdb_
         external   cotdb_
!                                 logical function pfile_
         external   pfile_
!                                 logical function pdata_
         external   pdata_
!                                 logical function pchar_
         external   pchar_
!                                 logical function pcmnt_
         external   pcmnt_
!                                 logical function pdelim_
         external   pdelim_
!                                 logical function pnumb_
         external   pnumb_
!                                 logical function pnumd_
         external   pnumd_
!                                 logical function ptext_
         external   ptext_
!                                 logical function ploop_
         external   ploop_
!                                 logical function prefx_
         external   prefx_

!!! END OF : ././RDINP/ciftbx.cmf 
!!! END OF : ././RDINP/ciftbx.cmn 
character*120,intent(in) :: cifname  ! cif-file that will be opened to read the crystal structure
integer,intent(inout) :: cif_equivalence ! Different schemes for choosing unique potentials
! local variables:
logical f1,f2,f3,inside
character*80 line
real*8 a,b,c,sig,alpha,beta,gamma,vec(3),lattice(3,3),deg2rad,cellmin(3),cellmax(3),dummy
real*8,allocatable :: x(:),y(:),z(:),xn(:,:),dpos(:,:)
character*5,allocatable :: symbol(:),label(:),symbol_old(:),label_old(:)
character*5 zname
character*20 symcell,sym(200) 
character*8 sgrhm
character*2 str2
character*10 sgrhm1 !dummy
integer syminttablesnr
integer nat,nsym,i,j,ki,kj,l,index,iorigin,i1,i2,i3
real*8,allocatable :: pos(:,:),cpos(:,:),dist(:)
integer,allocatable :: mult(:),indequiv(:),iz(:),pot(:),firstpos(:),iz_old(:)
integer nat_cif,nat_ineq,nat_all,nat_temp
integer,parameter :: nat_start=100
character*3 lattyp
character*52,parameter :: alphabet='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
character*512 slog
logical,parameter :: verbose=.false.


! Assign the CIFtbx files
f1=init_(1,2,3,6)

! Request dictionary validation check
!if (.not. dict_('/Users/jorissen/science/feff90/src/RDINP/cif_core.dic','valid')) write(6,*) 'Requested Core dictionary not present'
if (.not. dict_('cif_core.dic','valid')) write(6,*) 'Requested Core dictionary not present'


! Open the CIF
if (.not. ocif_(cifname)) stop 'CIF cannot be opened'
if (verbose) call wlog('cif file opened')

! Assign the data block to be accessed
120 continue
if (.not.data_(' ')) goto 200

! Read cell dimensions
f1=numd_('_cell_length_a',a,sig)
f2=numd_('_cell_length_b',b,sig)
f3=numd_('_cell_length_c',c,sig)
if(.not. (f1.and.f2.and.f3)) write(6,*) 'Cell lengths missing'
f1=numd_('_cell_angle_alpha',alpha,sig)
f2=numd_('_cell_angle_beta',beta,sig)
f3=numd_('_cell_angle_gamma',gamma,sig)
if(.not. (f1.and.f2.and.f3)) write(6,*) 'Cell angles missing'
deg2rad=acos(-1.0d0)/dble(180)
alpha=alpha*deg2rad
beta=beta*deg2rad
gamma=gamma*deg2rad



allocate(x(nat_start),y(nat_start),z(nat_start),symbol(nat_start),label(0:nat_start))
x=0. ; y=0. ; z=0. ; symbol='' ; label=''
nat_cif=0
! Extract atom site data
160 continue
nat_cif=nat_cif+1
f1=char_('_atom_site_type_symbol',symbol(nat_cif)) ! e.g. "Ge"
f2=char_('_atom_site_label',label(nat_cif))  ! e.g. "Ge1" or also "Ge"
if (f2 .and. (.not.f1)) symbol(nat_cif)=label(nat_cif)
if (.not.f1 .and. .not.f2) stop 'error type of atom not specified'
f2=numd_('_atom_site_fract_x',x(nat_cif),sig)
f2=numd_('_atom_site_fract_y',y(nat_cif),sig)
f2=numd_('_atom_site_fract_z',z(nat_cif),sig)
if (loop_) goto 160

!Correct fractions - cif's are often less accurate than theoretical symmetry routines
do i=1,nat_cif
index=12
do j=1,index
   if (dabs(x(i)-dble(j)/dble(index)).lt.0.0002) x(i)=dble(j)/dble(index)  ! so 0.6667 becomes 0.66666666666...
   if (dabs(y(i)-dble(j)/dble(index)).lt.0.0002) y(i)=dble(j)/dble(index)  ! so 0.6667 becomes 0.66666666666...
   if (dabs(z(i)-dble(j)/dble(index)).lt.0.0002) z(i)=dble(j)/dble(index)  ! so 0.6667 becomes 0.66666666666...
enddo
do j=1,8
   if (dabs(x(i)-dble(j)/dble(index)).lt.0.0002) x(i)=dble(j)/dble(index)  ! so 0.6667 becomes 0.66666666666...
   if (dabs(y(i)-dble(j)/dble(index)).lt.0.0002) y(i)=dble(j)/dble(index)  ! so 0.6667 becomes 0.66666666666...
   if (dabs(z(i)-dble(j)/dble(index)).lt.0.0002) z(i)=dble(j)/dble(index)  ! so 0.6667 becomes 0.66666666666...
enddo
enddo   


! Space group
f1=char_('_symmetry_cell_setting',symcell)  ! e.g. "hexagonal" ; this variable is not currently used
f2=char_('_symmetry_space_group_name_H-M',sgrhm1)  ! e.g. "P 63/m m c"
f3=numd_('_symmetry_Int_Tables_number',dummy,sig) ! e.g. "194"
if (f3) syminttablesnr=nint(dummy)
if(.not.f2 .and. .not.f3) stop "Spacegroup not specified in CIF file."
!Now, some idiotic code to get rid of redundant whitespaces and whatnot:
j=0
sgrhm='        '
!write(*,*) 'sgrhm1',sgrhm1
do i=1,10
   if (sgrhm1(i:i).ne." ") then
      j=j+1
	  sgrhm(j:j)=sgrhm1(i:i)
   endif
   if (j.ge.8) exit
   if(i.lt.10) then
       if (sgrhm1(i+1:i+1).eq.'{'.or.sgrhm1(i+1:i+1).eq.':') exit  !added a condition to remove { ... } comments or things like " :1"
   endif
enddo
!write(*,*) 'sgrhm',sgrhm
if(f2 .and. .not.f3) call getsgnum(sgrhm,syminttablesnr)
if(f3 .and. .not.f2) call getsgrhm(syminttablesnr,sgrhm)
call getlattype(sgrhm,lattyp) ! lattyp is one of the  Bravais lattices, i.e., P, CXZ, CYZ, F, B, H, R
if(lattyp.eq."   ") then
   call wlog("Something unexpected happened in spacegroup input; setting lattice type to Primitive.")
   lattyp="P  "
endif
!write(*,*) 'lattyp',lattyp

! Symmetry operations
nsym=0
sym=""
170 continue
nsym=nsym+1
f1=char_('_symmetry_equiv_pos_as_xyz',sym(nsym))
if(loop_) goto 170


goto 120  !This is a loop over "data blocks", i.e. sections in the .cif file.  (Many .cif files will have only one section.)  We loop over all of them to make
! sure we find the info we need.  Once the whole file is read, we pass through the 200 continue statement and proceed with processing tasks.)
200 continue

call close_   ! Closes the .cif file; we are now done using the CIFTBX library.
if (verbose) call wlog ('Done reading .cif file.')


! Now generate the FULL list of atom positions in the unit cell, from the basic list of positions in the CIF file.
! This is actually not so easy because the sym ops are given in a computer-unfriendly way ...
   nat_ineq=nat_cif
   nat_all=0
   allocate(pos(3,nsym*nat_ineq),pot(nsym*nat_ineq),firstpos(nat_ineq))
   allocate(xn(3,nsym),mult(nat_ineq),indequiv(nsym),iz(0:nat_ineq))
   do i=1,nat_ineq
      vec(1)=x(i);vec(2)=y(i);vec(3)=z(i)
	  ! The cif-file may contain things like "O(1)" instead of "O" for atom type.  The following lines strip it down to something the findz routine will understand:
	  zname=symbol(i)
	  zname(3:5)='   '
	  f1=.false.
	  do j=1,52
	     if(zname(2:2).eq.alphabet(j:j)) f1=.true.
	  enddo
	  if(.not.f1) zname(2:2)=' '
	  label(i)=zname  !save stripped name
	  call findz(zname(1:2),iz(i))
      do j=1,nsym
         call apply_cifsymop(sym(j),vec,xn(1:3,j))         
      enddo
      call gen_equiv(nsym,xn,lattyp,indequiv,mult(i))
	  firstpos(i)=nat_all+1
      do j=1,mult(i)
         nat_all=nat_all+1
         pos(1:3,nat_all)=xn(1:3,indequiv(j))       
		 pot(nat_all)=i
      enddo
   enddo
   if(verbose) then
!     Let's see what we have now ...
!    "index" is now the number of atoms in the unit cell
     do i=1,nat_all
        write(*,'(i4,x,3(f12.5,x),a2)') i,pos(:,i),symbol(pot(i))
     enddo
     write(*,*)
   endif

! Now it is time for a crucial step.  We must choose the unique potentials.
if (cif_equivalence .eq. 4) then
   !The practical approach.  Use "1" for small cells and "2" if there are a lot of atoms.
   cif_equivalence=1
   if (nat_ineq .gt. nphx) cif_equivalence=2
endif
if (cif_equivalence .eq. 1) then
   !Stick with what's crystallographically correct
   if(verbose) call wlog('using exact crystallographic equivalence to choose unique potentials.')
elseif (cif_equivalence .eq. 2) then
   !FEFF-style : only care about atomic number Z, not about crystallographic environment
   if(verbose) call wlog('using atomic number to choose unique potentials.')
   !Yuck, we must renumber the whole damn list.
   if (nat_ineq .gt. 1) then
   nat_temp=1  ! The new number of inequivalent atoms
   mult(:)=0
   allocate(iz_old(0:nat_ineq),symbol_old(nat_start),label_old(0:nat_start))
   iz_old=iz 
   symbol_old=symbol
   label_old=label
   pot(1)=1
   mult(1)=1
   firstpos(1)=1
   do i=2,nat_all
      f1=.true.
      do j=1,i-1  !See if there's a previous atom with the same Z
	     if (iz(pot(j)) .eq. iz_old(pot(i)) .and. f1) then
		    pot(i)=pot(j)
			f1=.false.
			mult(pot(j))=mult(pot(j))+1
		 endif
	  enddo
	  if (f1) then  !First atom of this Z
	     nat_temp=nat_temp+1
		 iz(nat_temp)=iz_old(pot(i))
		 label(nat_temp)=label_old(pot(i))
		 symbol(nat_temp)=symbol_old(pot(i))
		 pot(i)=nat_temp
		 firstpos(nat_temp)=i
		 mult(nat_temp)=1
	  endif
   enddo
   
   nat_ineq=nat_temp
   deallocate(iz_old,symbol_old,label_old)		
   endif
   
elseif (cif_equivalence .eq. 3) then
   !Hybrid method : use crystallographic information up to nearest neighbors only
   if(verbose) call wlog('using approximate crystallographic equivalence to choose unique potentials - first shell.')
   stop 'not yet implemented'
else 
   call wlog('The EQUIVALENCE parameter for choosing unique potentials must be between 1 and 4.  Quitting now.')
   stop 'not yet implemented'
endif


if (nat_cif .gt. nphx) then
   write(slog,*) 'CIF file contains',nat_cif,' atom types, which is larger than the hardwired limit nphx=',nphx,'.'
   call wlog(slog)
   call wlog('You need to recompile FEFF or simplify the structure.  Exiting now.')
   stop
endif



! Now we have to be careful : at this point, we still have special lattice types (P,B,F,CXZ,CZY,CYZ,H).
! Meaning the basis vectors are given for the conventional cell, while the positions are given for the primitive cell.
! The way FEFF currently works, that's going to give problems.  Either have it all primitive, or all conventional.
! Primitive requires changing the basis (lattice) vectors.  Conventional requires creating extra atom positions.
! Typically, the primitive cell has fewer atoms (by definition) but the conventional cell has higher symmetry.
! This higher symmetry results in a smaller k-mesh; however, symmetry is currently not used to reduce the computational
! cost of calculating G(k).
! Overall I think that the primitive cell is the fastest way to go in the current version of FEFF.  (Verified in a few cases.)
! However we pass everything on as is at this point.
! Reciprocal.inp will contain stuff as it is here.
! Then in each module, during setup, the routine crystalstructure is called.
! This converts us to the primitive lattice.



! Set up the absorber:
! Be careful here - with CIF, "absorber" counts inequivalent positions; without CIF, "absorber" counts the positions in the ATOMS card.  This is altogether different ...
iz(0)=iz(m_absorber)   
label(0)=label(m_absorber)


! So far, the lattice vectors have only been specified by length and angle.  Let's now make the vectors explicitly, in carthesian coordinates.
! choose c || e_z
lattice(:,:)=dble(0)
lattice(3,3)=c
! we have one more choice; let's make b _|_ e_x
lattice(2,3)=dcos(alpha)*b
lattice(2,2)=dsin(alpha)*b
! and then it follows for a that ...
lattice(1,3)=dcos(beta)*a
lattice(1,2)=((dcos(gamma)-dcos(beta)*dcos(alpha))/dsin(alpha))*a
lattice(1,1)=dsqrt(a**2-lattice(1,2)**2-lattice(1,3)**2)

! Now print out unit cell position in Carthesian coordinates
allocate(cpos(3,nat_all))
allocate(dist(nat_all)) ! for testing
cpos=dble(0)
do i=1,nat_all
do j=1,3
   cpos(j,i)=pos(1,i)*lattice(1,j)+pos(2,i)*lattice(2,j)+pos(3,i)*lattice(3,j)
enddo
enddo

! Shift origin
iorigin=firstpos(m_absorber) !=7
vec(:)=cpos(:,iorigin)
do i=1,nat_all
do j=1,3
   cpos(j,i)=cpos(j,i)-vec(j) !cpos(j,iorigin) - somehow that makes the compiler produce rubbish ...
enddo
enddo

! After this transformation pos -> cpos, some positions may not be in the unit cell anymore.  Bring them back in.
! The cell boundaries in carthesian coordinates :  ! [0,1]^3 in lattice coordinates
cellmin=dble(0)
cellmax=dble(0)
do i1=0,1 ; do i2=0,1 ; do i3=0,1
   do j=1,3
      vec(j)=i1*lattice(1,j)+i2*lattice(2,j)+i3*lattice(3,j)
	  if (vec(j).lt.cellmin(j)) cellmin(j)=vec(j)
	  if (vec(j).gt.cellmax(j)) cellmax(j)=vec(j)
   enddo
enddo ; enddo ; enddo

do i=1,nat_all
   inside=(cpos(1,i).ge.cellmin(1) .and. cpos(1,i).le.cellmax(1) &
      .and. cpos(2,i).ge.cellmin(2) .and. cpos(2,i).le.cellmax(2)  &
	  .and. cpos(3,i).ge.cellmin(3) .and. cpos(3,i).le.cellmax(3) )
   if (.not.inside) then
      do i1=-3,3 ; do i2=-3,3 ; do i3=-3,3
	     if(.not.inside) then
	     do j=1,3
	        vec(j)=cpos(j,i)+i1*lattice(1,j)+i2*lattice(2,j)+i3*lattice(3,j)
	     enddo
         inside=(vec(1).ge.cellmin(1) .and. vec(1).le.cellmax(1) &
		 .and. vec(2).ge.cellmin(2) .and. vec(2).le.cellmax(2)  &
		 .and. vec(3).ge.cellmin(3) .and. vec(3).le.cellmax(3) )
		 if (inside) cpos(:,i)=vec(:)
	     endif
	 enddo; enddo; enddo
   endif
   if (.not.inside) write(*,*) 'Insideing failed for atom ',i
enddo

! As a check, find distance from "central atom"
do i=1,nat_all
dist(i)=dsqrt((cpos(1,i)-cpos(1,iorigin))**2+(cpos(2,i)-cpos(2,iorigin))**2+(cpos(3,i)-cpos(3,iorigin))**2)
enddo

if (verbose) then
   do i=1,nat_all
      write(*,'(i4,x,3(f12.5,x),a2,3x,f12.5)') i,cpos(:,i),symbol(pot(i)),dist(i)
   enddo
   write(*,*)
   do i=1,3
      write(*,'(3(f12.5,x))') lattice(i,:)
   enddo
   write(*,*) 'lattyp ',lattyp
endif

! "Translate" the absorber to FEFF language
! i.e., instead of giving a potential index, give a position index
m_absorber=firstpos(m_absorber)

! Copy variables into the "struct" module so the rest of the program can use them:
m_nsym=nsym
m_nats=nat_all
m_nph=nat_ineq
m_a1=lattice(1,:)
m_a2=lattice(2,:)
m_a3=lattice(3,:)
!KJ Something really weird happens here ; using ifort12.5 on Mac 10.7.2, "cpos" gets corrupted, apparently during the call to m_init_struct.
!   I don't understand what I'm during wrong.
!   Creating "dpos" seems to avoid whatever the compiler otherwise trips up on.
!   If anyone understands why, please explain it to me ...
allocate(dpos(3,m_nats))
do i=1,m_nats
dpos(:,i)=cpos(:,i)
enddo

m_latticename=lattyp
m_lattice=lattyp(1:1)
call m_init_struct(m_nats)  !Allocates the necessary arrays
m_natom(1:m_nph)=mult(1:nat_ineq)
m_ppot(1:m_nats)=pot(1:nat_all)
do i=0,nat_ineq ! copy 5-string to 2-string carefully:
   zname=label(i)
   str2=zname(1:2)
   m_label(i)=str2
enddo
!!!m_label(0:m_nph)=label(0:nat_ineq)
m_izatom(0:m_nph)=iz(0:nat_ineq)
!m_ppos(1:3,1:m_nats)=pos(1:3,1:nat_all) !for WIEN2k-like coordinates, i.e. "ICOORD=4" ; neither of below
m_ppos(1:3,1:m_nats)=dpos(1:3,1:nat_all) !for FEFF-like coordinates, i.e. "ICOORD=1" ; origin at absorber and within first unit cell 
m_ppos=m_ppos/a !Convert the FEFF-like coordinates to SPRKKR-like coordinates by dividing by length of first lattice vector
m_sgroup=syminttablesnr
m_sgroup_hm=sgrhm
m_firstpos(1:m_nph)=firstpos(1:nat_ineq)
!!!!if (m_lattice.eq.'H' .or. m_lattice.eq.'R') m_lattice='P'

return
end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: iniall.f90,v $:
! $Revision: 1.13 $
! $Author: bmattern $
! $Date: 2012/02/09 18:04:57 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine iniall

!     initializes all input variables
!     written by Alexei Ankudinov , march 2001.
!     complete overhaul Kevin Jorissen, july 2009

      use geometry_inp
	  use global_inp
	  use reciprocal_inp
	  use potential_inp
	  use ldos_inp
      use opcons_inp
	  use screen_inp
	  use xsph_inp
	  use fms_inp
	  use paths_inp
	  use genfmt_inp
	  use ff2x_inp
	  use sfconv_inp
	  use eels_inp
      use compton_inp

      implicit none

!  called in order of appearance in case one initialization affects the next
!  (modules get variables in first come first served order!)
!  although I don't think such dependencies occur at initialization level.      
	  call geometry_init
	  call global_init
	  call reciprocal_init
	  call potential_init
	  call ldos_init
      call opcons_init
	  call screen_init
	  call xsph_init
	  call fms_init
	  call paths_init
	  call genfmt_init
	  call ff2x_init
      call sfconv_init
	  call eels_init
      call compton_init
      

      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: rdline.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       subroutine rdline(jinit, line)
!
!  return next "real" command line from input file(s)
!    -  allows use of "include file" or "load file" for reading
!       from other files, and manages the set of include files
!    -  checks for and ignores comment lines and blank lines.
!    -  opens and closes all input files, including initial file.
!
!   jinit  initialization/clean-up flag     [in]
!   line   next command line to parse   [in/out]
!
! notes:
!   1. to initialize, set jinit<0 and line= main_input_file_name.inp
!      if line=' ', routine will stop program.
!   2. returned line will be sent through triml and untab.
!   3. uses routine iscomm to test if line is a comment line.
!   4. special returned values:
!        'read_line_end'  = done reading all inputs
!        'read_line_error'= an error has occurred. the calling routine
!                        should probably stop
!   5. to clean up all open files, call with jinit=0
!
! matt newville march 1999
       implicit none
       integer mwords, ilen, i, jinit, mfil, nfil
       parameter (mwords=2, mfil=10)
       character*(*) line, stat*8
       character*90  files(mfil), errmsg, words(mwords)
       parameter (stat='old')
       integer   iunit(mfil), istrln, nwords, ierr, iexist
       logical   iscomm, open
       external  istrln, iscomm
       save      files, iunit, nfil
!
! jinit=-1: initialize
       if (jinit.eq.-1) then
          jinit  = 1
          do 10 i = 1, mfil
             iunit(i) = 0
             files(i) = ' '
 10       continue
          nfil     = 1
          files(1) = line
          call triml(files(1))
          call openfl(iunit(1), files(1), stat, iexist, ierr)
          if (iexist .lt. 0) go to 2600
          if (ierr   .lt. 0) go to 2800
!
!  jinit=0:  close all opened files (except unit 5!)
       elseif (jinit.eq.0) then
          jinit = 1
          do 25, i = 1, mfil
             if ((iunit(i).gt.0).and.(iunit(i).ne.5)) then 
                inquire(unit = iunit(i), opened=open)
                if (open) then
                   close(iunit(i))
                   iunit(i) = 0
                   files(i) = ' '
                endif 
             endif 
 25       continue 
          return
       end if
!  read next line from current input file
 100   continue
!c       print*, 'rdline 100: nfil , files(nfil), iunit = ',
!c     $      nfil,files(nfil)(:20), iunit(nfil)
       line   = ' '
       read(iunit(nfil),'(a)', err =1000, end = 500) line
!
!  check if command line is 'include filename'.
!  if so, open that file, and put it in the files stack
       call untab(line)
       call triml(line)
       if (iscomm(line)) go to 100
       nwords = mwords
       words(2) = ' '
       call bwords(line, nwords, words)
       call lower(words(1))
       if (((words(1) .eq. 'include').or.(words(1) .eq. 'load'))        &
     &      .and. (nwords .gt. 1)) then
          nfil = nfil + 1
          if (nfil .gt. mfil) go to 2000
          call getfln(words(2), files(nfil), ierr)
          if (ierr .ne. 0) go to 2400
!  test for recursion:
          do 400 i = 1, nfil - 1
             if (files(nfil) .eq. files(i)) go to 3000
 400      continue
          call openfl(iunit(nfil), files(nfil), stat, iexist, ierr)
          if (iexist .lt. 0) go to 2600
          if (ierr   .lt. 0) go to 2800
          go to 100
       end if
       return
!
!  end-of-file for command line file: drop nfil by 1,
!  return to get another command line
 500   continue
       inquire(unit = iunit(nfil), opened=open)
       if (open .and. (iunit(nfil) .ne. 5)) then
          close(iunit(nfil))
       end if
       iunit(nfil) = 0
       files(nfil) = ' '
       nfil = nfil - 1
       if (nfil.gt.0) go to 100
       line = 'read_line_end'
       return
!   error messages
 1000  continue
       call wlog(' # read error: general error')
       go to 4500
 2000  continue
       call wlog(' # read error: too many nested "include"s')
       write(errmsg, '(1x,a,i3)') ' # current limit is ', mfil
       ilen  = istrln(errmsg)
       call wlog(errmsg(1:ilen))
       go to 4500
 2400  continue
       call wlog(' # read error: cannot determine file name')
       go to 4500
 2600  continue
       call wlog(' # read error: cannot find file')
       go to 4500
 2800  continue
       call wlog(' # read error: cannot open file')
       go to 4500
 3000  continue
       call wlog(' # read error: recursive use of file')
       go to 4500
 4500  continue
       errmsg = ' # >> file name = '//files(nfil)
       ilen   = istrln(errmsg)
       call wlog(errmsg(1:ilen) )
       line = 'read_line_error'
       return
! end subroutine read_line
       end
       subroutine getfln(strin, filnam, ierr)
!  strip off the matched delimeters from string, as if getting
!  a filename from "filename", etc.
       integer idel, iend, istrln, ierr
       character*(*) strin, filnam, tmp*144, ope*8, clo*8
       data ope, clo /'"{(<''[',  '"})>'']'/
!
       ierr  = 0
       tmp   = strin
       call triml(tmp)
       ilen  = istrln(tmp)
       idel  = index(ope,tmp(1:1))
       if (idel.ne.0) then
          iend = index(tmp(2:), clo(idel:idel) )
          if (iend.le.0) then
             ierr = -1
             iend = ilen 
          end if
          filnam = tmp(2:iend)
       else
          iend = index(tmp,' ') - 1
          if (iend.le.0) iend  = istrln(tmp) 
          filnam = tmp(1:iend)
       end if
       return
! end  subroutine getfln
       end
       subroutine openfl(iunit, file, status, iexist, ierr)
!  
!  open a file, 
!   if unit <= 0, the first unused unit number greater than 7 will 
!                be assigned.
!   if status = 'old', the existence of the file is checked.
!   if the file does not exist iexist is set to -1
!   if the file does exist, iexist = iunit.
!   if any errors are encountered, ierr is set to -1.
!
!   note: iunit, iexist, and ierr may be overwritten by this routine
       character*(*)  file, status, stat*10
       integer        iunit, iexist, ierr
       logical        opend, exist
       external nxtunt
!
! make sure there is a unit number and file name
       ierr   = -3
       iexist =  -1
       if (file .eq. ' ') return
       iexist = 0
       iunit  = nxtunt(iunit)
!
! if status = 'old', check that the file name exists
       ierr = -2
       stat =  status                          
       call lower(stat)
       if (stat.eq.'old') then
          iexist = -1
          inquire(file=file, exist = exist)
          if (.not.exist) return
          iexist = iunit
       end if
! 
! open the file
       ierr = -1
       open(unit=iunit, file=file, status=status, err=100)
       ierr = 0
 100   continue
       return
! end  subroutine openfl
       end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: setedg.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine setedg (a2, ihole)
      integer i, ihole
      character*2 a2, edglbl, edglbp
      dimension edglbl(0:29), edglbp(0:29)

      data edglbl / 'NO', 'K ', 'L1', 'L2', 'L3',                       &
     &            'M1','M2','M3','M4','M5',                             &
     &            'N1','N2','N3','N4','N5','N6','N7',                   &
     &            'O1','O2','O3','O4','O5','O6','O7',                   &
     &            'P1','P2','P3','P4','P5','R1' /
      data edglbp / '0', '1 ', '2', '3', '4',                           &
     &            '5','6','7','8','9',                                  &
     &            '10','11','12','13','14','15','16',                   &
     &            '17','18','19','20','21','22','23',                   &
     &            '24','25','26','27','28','29' /

      ihole  = -1
      do 10 i = 0,29
  10     if (a2 .eq. edglbl(i) .or. a2 .eq. edglbp(i) ) ihole  = i
      if (ihole  .lt. 0) call par_stop('unknown EDGE')

      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: wrtall.f90,v $:
! $Revision: 1.14 $
! $Author: bmattern $
! $Date: 2012/02/09 18:04:57 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine wrtall

!     all necessary input files for other modules.
!     version 1.0 written by Alexei Ankudinov, March 2001
!     Torn to shreds Kevin Jorissen 7-09
!     Now everything repackaged into modules COMMON/m_inpmodules.f90

!     Adding new variables now only involves declaring them in one module
!     in said file, and making sure they are both in the corresponding
!     input and output routine of the same module.  Done!

      use par, only: master
      use geometry_inp
	  use global_inp
	  use reciprocal_inp
	  use potential_inp
	  use ldos_inp
      use opcons_inp
	  use screen_inp 
	  use xsph_inp
	  use fms_inp
	  use paths_inp
	  use genfmt_inp
	  use ff2x_inp
	  use sfconv_inp
	  use eels_inp
      use compton_inp
	  implicit none

      if (.not. master) return

      call geometry_write_atoms
	  call global_write(.true.)
	  call reciprocal_write
	  call potential_write
      call ldos_write
      call opcons_write
	  call screen_write
	  call xsph_write
	  call fms_write
	  call paths_write
	  call genfmt_write
	  call ff2x_write
	  call sfconv_write
	  call eels_write
      call compton_write
! screen.inp is optional ; it is written by screen_inp_parse_and_write in the presence of a SCREEN card in feff.inp

     
      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: terp.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     interpolation and extrapolation by m-th order polynomial
!     maximum m = 3. Change nmax if needed.
!     Input x and y arrays, returns y value y0 at requested x value x0.
!     Dies on error.

      subroutine terp (x, y, n, m, x0, y0)
      implicit double precision (a-h, o-z)

      dimension x(n), y(n)

!     Find out between which x points x0 lies
      i = locat (x0, n, x)
      k = min( max(i-m/2,1) , n-m )
      call polint( x(k), y(k), m+1, x0, y0, dy)

      return
      end

      function locat (x, n, xx)
      integer  u, m, n
      double precision x, xx(n)

!     Binary search for index of grid point immediately below x.
!     Array xx required to be monotonic increasing.
!     Returns
!     0            x <  xx(1)
!     1            x =  xx(1)
!     i            x =  xx(i)
!     n            x >= xx(n)

      locat = 0
      u = n+1

   10 if (u-locat .gt. 1)  then
         m = (u + locat) / 2
         if (x .lt. xx(m))  then
            u = m
         else
            locat = m
         endif
         goto 10
      endif

      return
      end


!     These routines, terp1 and locat1, are special versions to
!     be used with ff2chi, which uses some single and some double
!     precision.  They are the same as the routines in terp.f.

      subroutine terp1 (x, y, n, x0, y0)
      implicit double precision (a-h, o-z)

      real x(n), y(n)

!     Find out between which x points x0 lies
      i = locat1 (x0, n, x)
!     if i < 1, set i=1, if i > n-1, set i=n-1
      i = max (i, 1)
      i = min (i, n-1)

      if (x(i+1) - x(i) .eq. 0)  stop 'TERP-1'

      y0 = y(i) +  (x0 - x(i)) * (y(i+1) - y(i)) / (x(i+1) - x(i))

      return
      end

      function locat1 (x, n, xx)
      integer  u, m, n
      double precision x
      real xx(n)

!     Binary search for index of grid point immediately below x.
!     Array xx required to be monotonic increasing.
!     Returns
!     0            x <  xx(1)
!     1            x =  xx(1)
!     i            x =  xx(i)
!     n            x >= xx(n)

      locat1 = 0
      u = n+1

   10 if (u-locat1 .gt. 1)  then
         m = (u + locat1) / 2
         if (x .lt. xx(m))  then
            u = m
         else
            locat1 = m
         endif
         goto 10
      endif

      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: polint.f90,v $:
! $Revision: 1.3 $
! $Author: jorissen $
! $Date: 2012/06/29 01:05:24 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine polint( xa, ya, n, x, y, dy)
!     draws a polynimial P(x) of order (n-1) through n points.
!     returns y = P(x) and dy - estimate of the error
!     adapted  from numerical recipies in fortran by Press et al.

      implicit double precision (a-h,o-z)
      integer n, nmax
      parameter (nmax=4)
      dimension xa(nmax), ya(nmax), c(nmax), d (nmax)

      ns = 1
      dif = abs (x-xa(1))
      do 10 i=1,n
         dift = abs(x-xa(i))
         if (dift.lt.dif) then
            ns = i
            dif = dift
         endif
         c(i) = ya(i)
         d(i) = ya(i)
  10  continue
      y = ya(ns)
      ns = ns-1
      do 30 m=1,n-1
         do 20 i=1,n-m
            ho = xa(i)-x
            hp = xa(i+m)-x
            w = c(i+1) - d(i)
            den = ho-hp
            if (den.eq.0) stop 'failure in polint'    !pause to stop  KJ 6-2012
            den = w/den
            d(i) = hp*den
            c(i) = ho*den
  20     continue
         if (2*ns .lt. n-m) then
            dy = c(ns+1)
         else
            dy = d(ns)
            ns = ns-1
         endif
         y = y + dy
  30  continue

      return
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: mkptz.f90,v $:
! $Revision: 1.7 $
! $Author: jorissen $
! $Date: 2011/06/25 00:03:25 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine mkptz (nat,rat)
!     choose new right handed frame of reference with z along spvec,
!      y along (xivec cross spvec); simpler choice if one of them is 0.
!     get all vectors in new frame and
!     makes polarization tensor ptz when z is rotated along k-vector

!     input:
!     ipol = 0  random k-vector orientation in 3d; ptz(i,j)=\delta_{i,j}
!     ipol = 1 for polarizion vector eps and it's  complex conjugate epc
!        ptz(j,i) = 0.5 [(eps(-i))^* eps(-j) + (epc(-i))^* epc(-j)]
!        notice that complex conjugation and taking i-th component
!        are non commuting operations. (eps(-i))^* = (-)^i (epc(i))
!     ipol = 2 ptz(i,j)= i*\delta_{i,j}
!     elpty - ellipticity (optional for ipol=1)
!     xivec - direction of x-ray propagation
!     ispin - type of spin calculations
!        0 - spin independent
!        -1,1 - spin dependent potential
!        2 - calculations with spin-up potential
!       -2 - calculations with spin-down potential
!     spvec - direction of spin vector (along z at the output)
!     nat - number of atoms
!     rat - xyz cordinates of atoms (changed due to the rotations)

!     output:
!     angks - angle between k-vector and spin-vector (0-pi)
!     le2   - 0-only E1, 1-E1+M1, 2-E1+E2, 3-E1+E2+M1 transitions
!     ptz   - polarization tensor
      use constants
      use global_inp,only : ipol,elpty,evec,xivec,spvec,ispin,le2,angks,ptz,do_nrixs
      implicit double precision (a-h, o-z)

      integer,intent(in) :: nat
      double precision rat(3,nat)

!     additional local stuff to create polarization tensor ptz(i,j)
      dimension e2(3)
      complex*16  e(3),eps,epc
      dimension eps(-1:1),epc(-1:1)
      character*512 slog


!     make z axis along propagation (XIVEC).
!     le2=0 - only E1 transitions; le2=1 - E1+M1; le2=2 - E1+E2 
      rr = xivec(1)**2 + xivec(2)**2 + xivec(3)**2
      if (rr.eq.0) then
        angks = 0
!       special case when xivec is not specified
        if (ipol.eq.1) then
!         need to know xivec for E2 and M1 transitions
!         leave only E1 contribution
          if (le2.ne.0) call wlog('  Can do only E1 transitions. Specify k-vector for M1 or E2')
          le2 = 0
        else
!         for polarization average of circular dichroizm
          if (ispin.ne.0) then
!           spin-dependent case
            do 10 i = 1,3
  10        xivec(i) = spvec(i)
            rr = xivec(1)**2 + xivec(2)**2 + xivec(3)**2
          endif
        endif
      endif
            
              
      if (rr.gt.0 .and. (.not.(do_nrixs.eq.1))) then
         rsp = sqrt(rr)
         rr = xivec(1)**2 + xivec(2)**2
         if ( rr.ne.0 .or. xivec(3).lt.0) then
           if (rr.eq. 0) then
             cst = - 1
             snt = 0
             csf = 1
             snf = 0
           else
!            rotation is defined by angles theta and fi
             rr = sqrt(rr)
             cst = xivec(3) / rsp
             snt = rr / rsp
             csf = xivec(1) / rr
             snf = xivec(2) / rr
           endif
!          rotate all vectors
           do 20 i = 1, nat
 20        call rotate (rat(1,i), cst, snt, csf, snf)
           call rotate (evec, cst, snt, csf, snf)
           call rotate (xivec, cst, snt, csf, snf)
           call rotate (spvec, cst, snt, csf, snf)
         endif
      endif


!KJ 7-09 following code needs to run for feff8q
      if(do_nrixs.eq.1) then
!        Now the momentum transfer is along the z-axis 
!        Let us define a fake polarization vector that is perpendicular to it. 
         ipol=1
         evec(1)=0.707d0
         evec(2)=0.707d0
         evec(3)=0.0d0
      endif
!KJ

!     initialize ptz
      ptz(:,:) = 0

!     make ptz in the frame when z is along xivec, except ipol=0
      if (ipol .eq. 0) then
         do 40 i=-1,1
 40      ptz(i,i) = 1.d0 /3.d0
      elseif (ipol .eq. 2) then
         ptz( 1, 1) =  1.d0
         ptz(-1,-1) = -1.d0
      elseif (ipol .eq. 1) then
!       Normalize polarization vector
        x = sqrt (evec(1)**2 + evec(2)**2 + evec(3)**2)
        if (x .le. 0.000001) then
         call wlog(' STOP  Polarization vector of almost zero length.  Correct POLARIZATION card.')
         call par_stop('MKPTZ-1')
        endif
        do 50  i = 1, 3
         evec(i) = evec(i) / x
  50    continue
        x = sqrt (xivec(1)**2 + xivec(2)**2 + xivec(3)**2)
        if (x .gt. 0) then
!         run elliptical polarization code
          do 60  i = 1, 3
            xivec(i) = xivec(i) / x
  60      continue
          x = evec(1)*xivec(1)+evec(2)*xivec(2)+evec(3)*xivec(3)
          if (abs(x) .gt. 0.9) then
            call wlog(' polarization')
            write(slog,292)  (evec(i), i=1,3)
            call wlog(slog)
            call wlog(' incidence')
            write(slog,292) (xivec(i), i=1,3)
            call wlog(slog)
            call wlog(' dot product')
            write(slog,292)  x
            call wlog(slog)
  292       format (5x, 1p, 2e13.5)
            call wlog(' STOP polarization almost parallel to the incidence.')
            call wlog(' Correct ELLIPTICITY and POLARIZATION cards.')
            call par_stop('MKPTZ-2')
          endif
          if (x .ne. 0.0) then
!           if xivec not normal to evec then make in normal, keeping the
!           plane based on two vectors
            call wlog(' Changing polarization vector! Incidence is not normal to polarization.')
            call wlog(' Check your input for errors. Run continues.')
            do 70  i = 1,3
              evec(i) = evec(i) - x*xivec(i)
  70        continue
            x = sqrt (evec(1)**2 + evec(2)**2 + evec(3)**2)
            do 80   i = 1, 3
               evec(i) = evec(i) / x
  80        continue
          endif
        else
!         elpty cannot be used with xivec=0
          elpty = 0.0
        endif 
     
        e2(1) = xivec(2)*evec(3)-xivec(3)*evec(2)
        e2(2) = xivec(3)*evec(1)-xivec(1)*evec(3)
        e2(3) = xivec(1)*evec(2)-xivec(2)*evec(1)
        do 90   i = 1,3
          e(i) = (evec(i)+elpty*e2(i)*coni)
  90    continue 
        eps(-1) =  (e(1)-coni*e(2))/sqrt(2.0)
        eps(0)  =   e(3)
        eps(1)  = -(e(1)+coni*e(2))/sqrt(2.0)
        do 100  i = 1,3
          e(i) = (evec(i)-elpty*e2(i)*coni)
  100   continue 
        epc(-1) =  (e(1)-coni*e(2))/sqrt(2.0)
        epc(0)  =   e(3)
        epc(1)  = -(e(1)+coni*e(2))/sqrt(2.0)
        do 110 i = -1,1
        do 110 j = -1,1
!         ptz(j,i) = (-1.0)**i * epc(i)*eps(-j) / (1+elpty**2)
!         above - true polarization tensor for given ellipticity, 
!         below - average over left and right in order to have
!         path reversal symmetry
          ptz(j,i) = ((-1.0)**i)*(epc(i)*eps(-j)+eps(i)*epc(-j))        &
     &               /(1+elpty**2)/2.0
  110   continue
      endif
!     end of making polarization tensor

      angks = 0


!     second rotate so that z parallel to spin
!     note that new y-axis is normal to spin AND incidence vector
!     which simplifies further expression for rotation matrix
      rr = spvec(1)**2 + spvec(2)**2 + spvec(3)**2
      if (rr.gt.0) then
         rsp = sqrt(rr)
         rr = spvec(1)**2 + spvec(2)**2
         if ( rr.ne.0 .or. spvec(3).lt.0) then
           if (rr.eq. 0) then
             cst = - 1
             snt = 0
             csf = 1
             snf = 0
             angks = pi
           else
!            rotation is defined by angles theta and fi
             rr = sqrt(rr)
             cst = spvec(3) / rsp
             snt = rr / rsp
             csf = spvec(1) / rr
             snf = spvec(2) / rr
             angks = acos( cst)
           endif
!          rotate all vectors
           do 120 i = 1, nat
 120       call rotate (rat(1,i), cst, snt, csf, snf)
           call rotate (evec, cst, snt, csf, snf)
           call rotate (xivec, cst, snt, csf, snf)
         endif
      endif

      return
      end

      subroutine rotate (vec, cst, snt, csf, snf)
      implicit double precision (a-h, o-z)
!     rotates vector to a new coordinate system
!     Euler angles: alpha=phi, beta=theta, gamma=0
      dimension vec(3), temp (3)

      temp(1) = vec(1)*cst*csf + vec(2)*cst*snf - vec(3)*snt
      temp(2) = -vec(1)*snf + vec(2)*csf
      temp(3) = vec(1)*csf*snt + vec(2)*snt*snf + vec(3)*cst
      do 10 i = 1,3
  10  vec(i) = temp(i)

      return
      end



 subroutine apply_cifsymop(symname,x,xn)
! Given coordinates x(1:3) and a symmetry operation in .cif notation (symname),
! generate the coordinates xn by applying symname to x.
! The resulting numbers are 0 <= xn < 1
   integer irec
   character symname*(*)
   real*8    x(3),xn(3)
   integer n,i,j,lp
   character*10 part(3)
   real*8 a,b
   character symname1*50

   n=len_trim(symname)
   do jj=1,n
        if(symname(jj:jj).eq.'X')symname(jj:jj)='x'
        if(symname(jj:jj).eq.'Y')symname(jj:jj)='y'
        if(symname(jj:jj).eq.'Z')symname(jj:jj)='z'
   enddo

   i=index(symname,',',.false.)
   j=index(symname,',',.true.)
   part(1)=adjustl(symname(1:i-1))
   part(2)=adjustl(symname(i+1:j-1))
   part(3)=adjustl(symname(j+1:n))


   do i=1,3

      xn(i)=0.0d0  
      lp=0

      j=index(part(i),'-x')
      if (j.ne.0) then
         xn(i)=xn(i)-x(1)
         lp=lp+2 
      else
         j=index(part(i),'x')
         if (j.ne.0) then
            xn(i)=xn(i)+x(1)
            lp=lp+1 
            if (j.ne.1) lp=lp+1
         endif
      endif
      j=index(part(i),'-y')
      if (j.ne.0) then
         xn(i)=xn(i)-x(2) 
         lp=lp+2 
      else
         j=index(part(i),'y')
         if (j.ne.0) then
            xn(i)=xn(i)+x(2)
            lp=lp+1
            if (j.ne.1) lp=lp+1
         endif
      endif
      j=index(part(i),'-z')
      if (j.ne.0) then
         xn(i)=xn(i)-x(3) 
         lp=lp+2 
      else
         j=index(part(i),'z')
         if (j.ne.0) then
            xn(i)=xn(i)+x(3)
            lp=lp+1
            if (j.ne.1) lp=lp+1
         endif
      endif
      j=index(part(i),'/')
      if (j.ne.0) then
         if (j.eq.1.or.j.eq.len_trim(part(i))) stop   'wrong syntax in _symmetry_equiv_pos_as_xyz'
         read(part(i)(j-1:j-1),*) a
         read(part(i)(j+1:j+1),*) b
         if (j.eq.2) then
            xn(i)=xn(i)+a/b                  
            lp=lp+3
         else 
            if (part(i)(j-2:j-2).eq.'-') then
               xn(i)=xn(i)-a/b                  
               lp=lp+4
            else
               xn(i)=xn(i)+a/b                  
               lp=lp+4
            endif
         endif
         
      endif

      if (lp.ne.len_trim(part(i))) stop   'wrong syntax in _symmetry_equiv_pos_as_xyz'
  
   enddo

   do i=1,3
      if (xn(i).lt.0.0d0) xn(i)=xn(i)+1.0d0
      if (xn(i).gt.1.0d0) xn(i)=xn(i)-1.0d0
   enddo
   
   do i=1,3
      if (xn(i).lt.0.0d0) xn(i)=xn(i)+1.0d0
      if (xn(i).gt.1.0d0) xn(i)=xn(i)-1.0d0
   enddo
   
   do i=1,3
      if (xn(i).lt.0.0d0) xn(i)=xn(i)+1.0d0
      if (xn(i).gt.1.0d0) xn(i)=xn(i)-1.0d0
   enddo
   
   return
 end subroutine apply_cifsymop
 
 
 
 
 

 subroutine gen_equiv(nsym,xn,lattyp,indequiv,mult)

   integer nsym
   real*8  xn(3,nsym)
   character lattyp*(*)
   integer   indequiv(nsym),mult
   integer i,j,k
   logical thesame    

   mult=0
   do i=1,nsym
      do j=1,mult
         k=indequiv(j)
         if (thesame(lattyp,xn(1:3,k),xn(1:3,i))) goto 1
      enddo
      mult=mult+1
      indequiv(mult)=i
1     continue
   enddo

 end subroutine gen_equiv







 logical function thesame(lattyp,x1,x2)

    character lattyp*(*)
    real*8    x1(3),x2(3)
    real*8 tv(3,1000),dx(3),dxl,small,small2
    integer ind,i,j,k


    small=1.0d-5
    small2=small/2.0d0

    ind=0
    do i=-1,1
       do j=-1,1
          do k=-1,1
             ind=ind+1
             tv(1,ind)=i
             tv(2,ind)=j
             tv(3,ind)=k
          enddo 
        enddo
     enddo

     if (lattyp(1:1).eq.'B' .or. lattyp(1:1).eq.'I') then

        do i=-1,1,2
           do j=-1,1,2
              do k=-1,1,2
                 ind=ind+1
                 tv(1,ind)=0.5d0*i
                 tv(2,ind)=0.5d0*j
                 tv(3,ind)=0.5d0*k
              enddo
           enddo
        enddo

     else if (lattyp(1:1).eq.'F') then

        do i=-1,1,2
           do j=-1,1,2
              ind=ind+1
              tv(1,ind)=0.5d0*i
              tv(2,ind)=0.5d0*j
              tv(3,ind)=0.0d0
           enddo
        enddo
        do i=-1,1,2
           do j=-1,1,2
              ind=ind+1
              tv(1,ind)=0.5d0*i
              tv(2,ind)=0.0d0
              tv(3,ind)=0.5d0*j
           enddo
        enddo
        do i=-1,1,2
           do j=-1,1,2
              ind=ind+1
              tv(1,ind)=0.0d0
              tv(2,ind)=0.5d0*j
              tv(3,ind)=0.5d0*j
           enddo
        enddo

     else if (lattyp(1:3).eq.'CXY') then
          
        do i=-1,1,2
           do j=-1,1,2
              ind=ind+1
              tv(1,ind)=0.5d0*i
              tv(2,ind)=0.5d0*j
              tv(3,ind)=0.0d0
           enddo
        enddo

     else if (lattyp(1:3).eq.'CXZ') then

        do i=-1,1,2
           do j=-1,1,2
              ind=ind+1
              tv(1,ind)=0.5d0*i
              tv(2,ind)=0.0d0
              tv(3,ind)=0.5d0*j
           enddo
        enddo

     else if (lattyp(1:3).eq.'CYZ') then

        do i=-1,1,2
           do j=-1,1,2
              ind=ind+1
              tv(1,ind)=0.0d0
              tv(2,ind)=0.5d0*j
              tv(3,ind)=0.5d0*j
           enddo
        enddo

     endif

     thesame=.false.
     do i=1,ind
        dx(1:3)=x1(1:3)-x2(1:3)-tv(1:3,i)
        dx=dx+10.0d0
        dx=mod(dx+small2,1.0d0)-small2
        if (abs(dx(1)-1.0d0).lt.small2) dx(1)=0.0d0
        if (abs(dx(2)-1.0d0).lt.small2) dx(2)=0.0d0
        if (abs(dx(3)-1.0d0).lt.small2) dx(3)=0.0d0

        dxl=sqrt(dx(1)**2+dx(2)**2+dx(3)**2)
        if (dxl.lt.small) then
           thesame=.true.
           return
        endif
     enddo

  end function thesame

!
!
!    \ | /            /##|    @@@@  @   @@@@@   |      |             @    @
!     \|/ STAR       /###|   @      @   @     __|__    |             @    @
!  ----*----        /####|  @       @   @@@@    |      |___  __  __  @@@@@@
!     /|\          /#####|   @      @   @       |      |   \   \/         @
!    / | \         |#####|    @@@@  @   @       \___/  \___/ __/\__       @
!                  |#####|________________________________________________
!                 ||#####|                 ___________________            |
!        __/|_____||#####|________________|&&&&&&&&&&&&&&&&&&&||          |
!<\\\\\\\\_ |_____________________________|&&& 29 Nov 2009  &&||          |
!          \|     ||#####|________________|&&&&&&&&&&&&&&&&&&&||__________|
!                  |#####|
!                  |#####|                Version 4.1.0 Release
!                  |#####|
!                 /#######\
!                |#########|
!                    ====
!                     ||
!           An extended tool box of fortran routines for manipulating CIF data.
!                     ||
!                     ||  CIFtbx Version 4
!                     ||        by
!                     ||
!                     ||  Sydney R. Hall (syd@crystal.uwa.edu.au)
!                     ||  Crystallography Centre
!                     ||  University of Western Australia
!                     ||  Nedlands 6009, AUSTRALIA
!                     ||
!                     ||       and
!                     ||
!                     ||  Herbert J. Bernstein (yaya@bernstein-plus-sons.com)
!                     ||  Bernstein + Sons
!                     ||  5 Brewster Lane
!                     ||  Bellport, NY 11713, U.S.A.
!                     ||
! The latest program source and information is available from:
!                     ||
! Em: syd@crystal.uwa.edu.au       ,-_|\      Sydney R. Hall
! sendcif@crystal.uwa.edu.au      /     \     Crystallography Centre
! Fx: +61 9 380 1118  ||      --> *_,-._/     University of Western Australia
! Ph: +61 9 380 2725  ||               v      Nedlands 6009, AUSTRALIA
!                     ||
!                     ||
!_____________________||_____________________________________________________
!
! This is a version of CIFtbx which has been extended to work with CIF2, DDLm,
! DDL 2 and mmCIF as well as with DDL 1.4 and core CIF dictionaries.  CIFtbx
! version 1 was written by Sydney R. Hall (see Hall, S. R., "CIF Applications
! IV.  CIFtbx: a Tool Box for Manipulating CIFs,"  J. Appl. Cryst (1993). 26,
! 482-494.  The revisions for version 2 were done by Herbert J. Bernstein
! and Sydney R. Hall (see Hall, S. R. and Bernstein, H. J., "CIFtbx 2:
! Extended Tool Box for Manipulating CIFs," J. Appl. Cryst.(1996). 29,
! 598-603)
!
! The revisions for releases 3 and 4 were done by Herbert J. Bernstein, work
! funded in part by the International Union of Crystallography
!
!___________________________________________________________________________
!
!
!    GENERAL TOOLS
!
!
!    init_      Sets the device numbers of files.   (optional)
!               [logical function always returned .true.]
!
!               <input CIF dev number> Set input CIF device     (def=1)
!
!               <output CIF dev number>Set output CIF device    (def=2)
!
!               <diracc dev number>    Set direct access formatted
!                                      scratch device number    (def=3)
!
!               <error  dev number>    Set error message device (def=6)
!
!
!
!    dict_      Requests a CIF dictionary be used for various data checks.
!               [logical function returned as .true. if the name dictionary
!               was opened and if the check codes are recognisable.  The
!               data item names used in the first dictionary loaded are
!               considered to be preferred by the user to aliases found
!               in dictionaries loaded in later calls.  On exit from dict_
!               the variable dicname_ is either equal to the filename, or,
!               if the dictionary had a value for the tag dictionary_name
!               of dictionary.title, dicname_ is set to that value.
!               The variable dicver_ is blank or set to the value of
!               _dictionary_version or of _dictionary.version  The check codes
!               'catck' and 'catno' turn on and off checking of dictionary
!               catgeory conventions.  The default is 'catck'.  The check
!               codes 'parck' and 'parno' turn on and off checking of
!               parent-child relationships.  The default of 'parck'.  Three check
!               codes control the handling of tags from the current dictionary
!               which duplicate tags from a dictionary loaded earlier.  These
!               codes ('first', 'final' and 'nodup') have effect only for the
!               current call to dict_  The default is 'first'.]
!
!               <dictionary filename>  A CIF dictionary in DDL format
!                                      or blank if just setting flags
!                                      or resetting the dictionary
!
!               <check code string>    The codes specifying the types of
!                                      checks to be applied to the CIF.
!
!                                      'valid'  data name validation check.
!                                      'dtype'  data item data type check.
!                                      'catck'  check datanames against
!                                               categories
!                                      'catno'  don't check datanames against
!                                               categories
!                                      'parck'  check datanames against
!                                               parent-child relationships
!                                      'parno'  don't check datanames against
!                                               parent-child relationships
!                                      'first'  accept first dictionary's
!                                               definitions of duplicate tags
!                                      'final'  accept final dictionary's
!                                               definitions of duplicate tags
!                                      'nodup'  do not accept duplicate tag
!                                               definitions
!                                      'parck'  check datanames against parent-
!                                               child relationahips
!                                      'parno'  don't check datanames against
!                                               parent-child relationships
!                                      'reset'  switch off checking flags
!                                      'close'  close existing dictionaries
!
!___________________________________________________________________________
!
!
!   CIF ACCESS TOOLS  ("the get_ing commands")
!
!
!
!    ocif_      Opens the CIF containing the required data.
!               [logical function returned .true. if CIF opened]
!
!               <CIF filename>        A blank name signals that the
!                                     currently open input CIF file
!                                     will be read.
!
!
!
!    data_      Identifies the data block containing the data to be requested.
!               [logical function returned .true. if block found]
!
!               <data block name>     A blank name signals that the next
!                                     encountered block is used (the block
!                                     name is stored in the variable bloc_).
!
!
!    bkmrk_     Saves or restores the current position so that data from
!               elsewhere in the cif can be examined.
!               [logical function returned as .true. on save if there was
!               room in internal storage to hold the current position, .true.
!               on restore if the bookmark number used was valid.  If the
!               argument is zero, the call is to save the position and return
!               the bookmark number in the argument.  If the argument is
!               non-zero, the call is to restore the position saved for the
!               bookmark number given.  The bookmark and the argument are
!               cleared.  The position set on return allow reprocessing of
!               the data item or loop row last processed when the bookmark
!               was placed.
!
!               NOTE:  All bookmarks are cleared by a call to data_]
!
!               <integer variable>    Bookmark number
!
!
!    find_      Find the location of the requested item in the CIF.
!               [The argument "name" may be a data item name, blank
!               for the next such item.  The argument "type" may be
!               blank for unrestricted acceptance of any non-comment
!               string (use cmnt_ to see comments), including loop headers,
!               "name" to accept only the name itself and "valu"
!               to accept only the value, or "head" to position to the
!               head of the CIF.  Except when the "head" is requested,
!               the position is left after the data item provided.  If the
!               item found is of type "name", posnam_ is set, otherwise,
!               posval_]
!
!               <data item name>      A blank name signals that the next
!                                     item of the type specified is needed
!
!               <data item type>      blank, 'head', 'name' or 'valu'
!
!               <character variable>  Returned string is of length long_.
!
!
!
!    test_      Identify the data attributes of the named data item.
!               [logical function returned as .true. if the item is present or
!               .false. if it is not. The data attributes are stored in the
!               common variables list_, type_, dictype_, diccat_ and dicname_.
!               The list, array, tuple or table attribites are stored in
!               ttype_, depth_ index_.
!
!               The values in dictype_, diccat_ and dicname_ are valid
!               whether or not the data item is found in the input CIF, as
!               long as the named data item is found in the dictionaries
!               declared by calls to dict_.  The data item name found
!               in the input CIF is stored in tagname_.  The appropriate
!               column numbers are stored in posnam_, posval_, posend_ and (for
!               numbers) in posdec_.  The quotation mark, if any, used is
!               stored in quote_.
!
!               list_ is an integer variable containing the sequential number
!               of the loop block in the data block. If the item is not within
!               a loop structure this value will be zero.
!
!               type_ is a character*4 variable with the possible values:
!                      'numb'  for number data
!                      'char'  for character data
!                      'text'  for text data
!                      'null'  if data missing or '?' or '.'
!                              also used for blank quoted fields if
!                              nblank_ is true
!
!               ttype_ is a character*4 variable with the container type:
!                      'list'  for list or array data   [item,...]
!                      'tupl'  for tuple data           (item,...)
!                      'tabl'  for table data           {item,...}
!               The meanings change if rdbkt_, rdbrc_ or rdprn_ are
!               false.  If rdbkt_ is false, the meanings are
!                      'tupl'  for tuple data           (item,...)
!                      'list'  for list or table data   {item,...}
!               If rdprn_ is false, then 'list' is used for all
!               container types.  If depth_ is 0, then ttype_ is not
!               valid and will contain '    '
!
!               depth_ is an integer variable with the depth into a
!               list, array, tuple or table.  A depth of zero means that
!               no list, array, tuple or table is being processed.
!
!               index_ is an integer variable with the index (from 1)
!               across a list, array, tuple or table.  An index of zero
!               means that no list, array, tuple or table is being processed.
!
!               dictype_ is a character*(NUMCHAR) variable with the type code
!               given in the dictionary entry for the named data item.  If
!               no dictionary was used, or no type code was specified, this
!               field will simply agree with type_.  If a dictionary was used,
!               this type may be more specific than the one given by type_.
!
!               diccat_ is a character*(NUMCHAR) variable with the category
!               of the named data item, or '(none)'
!
!               dicname_ is a character*(NUMCHAR) variable with the name of
!               the data item which is found in the dictionary for the
!               named data item.  If alias_ is .true., this name may
!               differ from the name given in the call to test_.  If alias_
!               is .false. or no preferred alias is found, dicname_ agrees with
!               the data item name.
!
!               tagname_ is a character*(NUMCHAR) variable with the name
!               of the data item as found in the input CIF.  It will be
!               blank if the data item name requested is not found in the
!               input CIF and may differ from the data item name provided
!               by the user if the name used in the input CIF is an
!               alias of the data item name and alias_ is .true.
!
!               posnam_, posval_, posend_  and posdec_ are integer variables
!               which may be examined if information about the horizontal
!               position of the name and data read are needed.  posnam_ is the
!               starting column of the data name found (most often 1).
!               posval_ is the starting column of the data value.  If the
!               field is numeric, then posdec_ will contain the effective
!               column number of the decimal point.  For whole numbers, the
!               effective position of the decimal point is one column to the
!               right of the field.  posend_ contains the ending column of the
!               data value.
!
!               quote_ is a character*3 variable which may be examined to
!               determine if a quotation character was used on character data.]
!
!               <data name>           Name of the data item to be tested.
!
!
!    dtype_     Return the dictionary type of a data name, if any.
!               [logical function returned as .true. if the item has a type
!               in the dctionary, .false. if not.  The type returned is
!               one of the base type used by type_ (see above), if possible]
!
!               <data name>          Name of the item for which a type is needed
!               <data type>          Returned type from the dictionary
!
!
!    name_      Get the NEXT data name in the current data block.
!               [logical function returned as .true. if a new data name exists
!               in the current data block, and .false. when the end of the data
!               block is reached.]
!
!               <data name>           Returned name of next data item in block.
!
!
!
!    numb_      Extracts the number and its standard deviation (if appended).
!               [logical function returned as .true. if number present. If
!               .false. arguments 2 and 3 are unaltered. If the esd is not
!               attached to the number argument 3 is unaltered.]
!
!               <data name>           Name of the number sought.
!
!               <real variable>       Returned number.
!
!               <real variable>       Returned standard deviation.
!
!
!
!    numd_      Extracts the number and its standard deviation (if appended)
!               as double precision variables.
!               [logical function returned as .true. if number present. If
!               .false. arguments 2 and 3 are unaltered. If the esd is not
!               attached to the number argument 3 is unaltered.]
!
!               <data name>           Name of the number sought.
!
!               <double precision variable>
!                                     Returned number.
!
!               <double precision variable>
!                                     Returned standard deviation.
!
!
!
!    char_      Extracts character and text strings.
!               [logical function returned as .true. if the string is present.
!               Note that if the character string is text this function is
!               called repeatedly until the logical variable text_ is .false.
!               Non-text blank (quoted blanks) or empty ('' or "") fields
!               are converted by char to a null field, if nblank_ is true.]
!
!               <data name>           Name of the string sought.
!
!               <character variable>  Returned string is of length long_.
!
!    charnp_    Extracts character and text strings.
!               [logical function returned as .true. if the string is present.
!               Note that if the character string is text this function is
!               called repeatedly until the logical variable text_ is .false.
!               If the value is found in a container, then charnp_ should
!               be called repeatedly until both text_ is false and depth_
!               is zero. 
!
!               Non-text blank (quoted blanks) or empty ('' or "") fields
!               are converted by char to a null field, if nblank_ is true.
!               Only the number of characters returned in the third argument
!               are set.  This value is never less than 1, but may be less
!               than the allocated length of the returned string.]
!
!               <data name>           Name of the string sought.
!
!               <character variable>  Returned string is of length long_.
!
!               <integer variable>    Returned length of valid characters.
!
!
!    cmnt_      Extracts the next comment from the data block.
!               [logical function returned as .true. if a comment is present.
!               The initial comment character "#" is _not_ included in the
!               returned string.  A completely blank line is treated as
!               a comment.  A comment may be extracted while reading a list,
!               array, tuple or table]
!
!               <character variable>  Returned string is of length long_.
!
!
!    delim_     Reports the most recently seen delimiter prior to the
!               most recently extracted tag or value at the specified
!               depth.  Outside of bracketed constructs, only delimiters
!               at depth 0 (top level) can be seen.  This is not the
!               quoting character for a quoted string or text field.
!               See the variable quote_.
!               [logical function returned as .true. if the depth is
!               not negative and greater than or equal to the current
!               depth.  At depth 0, in a correctly formatted CIF, the
!               delimiter returned is always a blank,]
!
!               <integer variable>    Depth
!                    
!               <character variable>  Returned string is of length 1
!
!               <integer variable>    column position of delimiter
!
!               <integer variable>    record position of delimiter
!
!
!
!    purge_     Closes existing data files and clears tables and pointers.
!               [subroutine call]
!
!____________________________________________________________________________
!
!
!
!   CIF CREATION TOOLS ("the put_ing commands")
!
!
!
!    pfile_     Create a file with the specified file name.
!               [logical function returned as .true. if the file is opened.
!               The value will be .false. if the file already exists.]
!
!               <file name>           Blank for use of currently open file
!
!
!
!    pdata_     Put a data block command into the created CIF.
!               [logical function returned as .true. if the block is created.
!               The value will be .false. if the block name already exists.
!               Produces a save frame instead of a data block if the
!               variable saveo_ is true during the call.  No block duplicate
!               check is made for a save frame.]
!
!               <block name>
!
!    pdelim_    Emit a specific delimiter
!               [logical function returned as .true. if the delimiter is
!               appropriate to the context.  Emitting a '(', '{' or '['
!               increases the output depth by one.  Emitting a ')', '}'
!               or ']' decreases the output depth by one.  Emitting a ' ',
!               ',' or ':' does not change the depth.  Emitting a ','
!               or ':' at depth_ 0 is an error that can be overridden
!               by the second argument being .true..  Emitting a ' ' at
!               a depth_ greater than 0 is an error that can be overridden
!               by the second argument being .true.. ]
!
!               <character variable>   The one-character delimiter string
!
!               <logical variable>     .true. if an invalid delimiter is
!                                      to be forced out
!
!               <integer variable>     Column position at which to write
!                                      the delimiter or 0 if not specified
!
!
!
!    ploop_     Put a loop_ data name into the created CIF.
!               [logical function returned as .true. if the invocation
!               conforms with the CIF logical structure.  If pposval_
!               is non-zero, the "loop_" header is positioned to
!               that column.  If pposnam_ is non-zero, the data name is
!               positioned to that column.]
!
!               <data name>         If the name is blank on the first call
!                                   of a loop, only the "loop_" is placed.
!
!
!
!    pchar_     Put a character string into the created CIF.
!               [logical function returned as .true. if the name is unique,
!               AND, if dict_ is invoked, is a name defined in the dictionary,
!               AND, if the invocation conforms to the CIF logical structure.
!               The action of pchar_ is modified by the variables pquote_ and
!               nblanko_.  If pquote_ is non-blank, it is used as a quotation
!               character for the string written by pchar_.  The valid values
!               are '''', '"', ';', '(', '{', '[', '''''''', and '"""'.
!               In the last six cases a text field, bracketed construct or
!               multi-line triple-quoted string is written.  If the string
!               contains a matching character to the value of quote_, or if
!               quote_ is not one of the valid quotation characters, a valid,
!               non-conflicting quotation character is used or the line-folding
!               conventions are used to prevent the close-quote from being
!               followed by white space.  Except when writing a text field, if
!               nblanko_ is true, pchar_ converts a blank string to
!               an unquoted period.]
!
!               <data name>         If the name is blank, do not output name.
!
!               <character string>  A character string of MAXBUF chars or less.
!
!
!
!    pcmnt_     Puts a comment into the created CIF.
!               [logical function returned as .true.  The comment character
!               "#" should not be included in the string.  A blank comment
!               is presented as a blank line without the leading "#"].
!
!               <character string>  A character string of MAXBUF chars or less.
!
!
!    pnumb_     Put a single precision number and its esd into the created CIF.
!               [logical function returned as .true. if the name is unique,
!               AND, if dict_ is invoked, is a name defined in the dictionary,
!               AND, if the invocation conforms to the CIF logical structure.
!               The number of esd digits is controlled by the variable
!               esdlim_]
!
!               <data name>         If the name is blank, do not output name.
!
!               <real variable>     Number to be inserted.
!
!               <real variable>     Esd number to be appended in parentheses.
!
!
!    pnumd_     Put a double precision number and its esd into the created CIF.
!               [logical function returned as .true. if the name is unique,
!               AND, if dict_ is invoked, is a name defined in the dictionary,
!               AND, if the invocation conforms to the CIF logical structure.
!               The number of esd digits is controlled by the variable
!               esdlim_]
!
!               <data name>         If the name is blank, do not output name.
!
!               <double precision variable>
!                                   Number to be inserted.
!
!               <double precision variable>
!                                   Esd number to be appended in parentheses.
!
!
!
!    ptext_     Put a character string into the created CIF.
!               [logical function returned as .true. if the name is unique,
!               AND, if dict_ is invoked, is a name defined in the dictionary,
!               AND, if the invocation conforms to the CIF logical structure.
!               ptext_ is invoked repeatedly until the text is finished. Only
!               the first invocation will insert a data name.
!
!               If used when pclipt_ is .true. if the first character of the
!               text field is blank, it is removed.
!
!               If used when pfold_ is non-zero, the text field will be marked
!               as folded even if the first line is small enough to fit.
!               In order to produce a non-folded text field in the midst
!               of generally folded items, pfold_ should be set to 0 before
!               calling ptext_ and then restored to the previous value.]
!
!               <data name>         If the name is blank, do not output name.
!
!               <character string>  A character string of MAXBUF chars or less.
!
!
!    prefx_     Puts a prefix onto subsequent lines of the created CIF.
!               [logical function returned as .true.  The second argument
!               may be zero to suppress a previously used prefix, or
!               greater than the non-blank length of the string to force
!               a left margin.  Any change in the length of the prefix
!               string flushes pending partial output lines, but does _not_
!               force completion of pending text blocks or loops.
!               This function allows the CIF output functions to be used
!               within what appear to be text fields to support annotation
!               of a CIF. ]
!
!               <character string>  A character string of MAXBUF chars or less.
!
!               <integer variable>  The length of the prefix string to use.
!
!
!
!
!    close_     Close the creation CIF. MUST be used if pfile_ is used.
!               [subroutine call]
!
!
!____________________________________________________________________________
!
!
!
!....The CIF tool box also provides variables for data access control:
!
!
!    alias_      Logical variable: if left .true. then all calls to
!                CIFtbx functions may use aliases of data item names.
!                The preferred synonym from the dictionary will be
!                subsituted internally, provided aliased data names were
!                supplied by an input dictionary (via dict_).  The
!                default is .true., but alias_ may be set to .false.
!                in an application.
!
!    aliaso_     Logical variable: if set .true. then cif output
!                routines will convert aliases to the names to preferred
!                synonyms from the dictionary.  The default is .false., but
!                aliaso_ may be set to .true. in an application.  The
!                setting of aliaso_ is independent of the setting of
!                alias_.
!
!    align_      Logical variable signals alignment of loop_ lists during
!                the creation of a CIF. The default is .true.
!
!    append_     Logical variable:  if set .true. each call to ocif_ will
!                append the information found to the current cif.  The default
!                is .false.
!
!    bloc_       Character*(NUMCHAR) variable: the current block name.
!
!    clipt_      Logical variable: if set .true., when reading text fields,
!                an extra blank is inserted before the character string
!                returned for the first line of a text field, emulating
!                the behavior of CIFtbx versions prior to version 4.
!
!    decp_       Logical variable: set when processing numeric input, .true.
!                if there is a decimal point in the numeric value, .false.
!                otherwise
!
!    depth_      Integer variable: set to the depth within a list, array, tuple
!                or table
!
!    dictype_    Character*(NUMCHAR) variable: the precise data type code
!                (see test_)
!
!    diccat_     Character*(NUMCHAR) variable: the category (see test_)
!
!    dicname_    Character*(NUMCHAR) variable: the root alias (see test_) or
!                the name of the dictionary just loaded (see dict_)
!
!    dicpname_   Character*(NUMCHAR) variable: the parent (see test_)
!
!    dicver_     Character*(NUMCHAR) variable: the version of the dictionary
!                just loaded (see dict_)
!
!    esdlim_     Integer variable:  Specifies the upper limit of esd's
!                produced by pnumb_, and, implicitly, the lower limit.
!                The default value is 19, which limits esd's to the range
!                2-19.  Typical values of esdlim_ might be 9 (limiting
!                esd's to the range 1-9), 19, or 29 (limiting esd's
!                to the range 3-29).  If esdlim_ is given as a negative
!                value, the upper limit of esd's is the absolute value
!                of esdlim_ and the lower limit is 1.
!
!    esddig_     Integer variable:  The number of esd digits in the last
!                number read from a CIF.  Will be zero if no esd
!                was given.
!
!    file_       Character*(MAXBUF) variable: the filename of the current file.
!                Warning:  only file_(1:longf_) is valid
!
!    fold_       Logical variable signals that the current text block
!                began with the ';\' fold indicator. Only meaningful
!                when text_ is .true. and type_ is 'text'.
!                (fold_ is .true. if the indicator is present)
!
!    glob_       Logical variable signals that the current data block
!                is actually a global block (.true. for a global block).
!
!    globo_      Logical variable signals that the output data block from
!                pdata_ is actually a global block (.true. for a global block).
!
!    index_      Integer variable: Specifies the one-based index of the current
!                item in a list, array, tuple or table
!
!    line_       Integer variable: Specifies the input/output line limit
!                for processing a CIF. The default value is 80 characters.
!                This may be set by the program. The max value is MAXBUF
!                which has a default value of 2048.  In order to use
!                the CIF 1.1 line folding protocol for lines that
!                cannot be fit into line_ characters, the variable
!                pfold_ must be set to a non-zero value less than
!                or equal to line_
!
!    list_       Integer variable: the loop block number (see test_).
!
!    long_       Integer variable: the length of the data string in strg_.
!
!    longf_      Integer variable: the length of the filename in file_.
!
!    loop_       Logical variable signals if another loop packet is present.
!
!    lzero_      Logical variable: set when processing numeric input, .true.
!                if the numeric value is of the form [sign]0.nnnn rather than
!                [sign].nnnn, .false. otherwise
!
!    nblank_     Logical variable: if set .true. then all calls to
!                to char_ or test_ which encounter a non-text quoted blank
!                will return the type as 'null' rather than 'char'.
!
!    nblanko_    Logical variable: if set .true. then cif output
!                routines will convert quoted blank strings to an
!                unquoted period (i.e. to a data item of type null).
!
!    pclipt_     Logical variable: if set .true., when writing text fields,
!                if there is a blank as the first character to be written,
!                it is removed, emulating the behavior of CIFtbx versions
!                prior to version 4.
!
!    pdecp_      Logical variable: if set .true. then cif numeric output
!                routines will insert a decimal point in all numbers written by
!                pnumb_ or pnumbd_.  If set .false. then a decimal point will be
!                written only when needed.  The default is .false.
!
!    pesddig_    Integer variable: if set non-zero, and esdlim_ is negative,
!                controls the number of digits for esd's produced by
!                pnumb_ and pnumd_
!
!    pfold_      Integer variable:  If set non-zero, specifies a column
!                on which output lines are to be folded.  The default is 0.
!                If pfold_ is set to a value greater than line_ the
!                value of line_ will be used instead.  Non-zero values of
!                pfold_ less than 4 are not valid and will be reset to 4.
!                Non-zero values of pfold_ less than 80 can cause conflict
!                with the syntactic requirements of creating a valid CIF.
!
!    plzero_     Logical variable: if set .true. then cif numeric output
!                routines will insert a zero before a leading decimal point,
!                The default is .false.
!
!    pposdec_    Integer variable giving the position of the decimal point
!                for the next number to be written.  This acts very much like
!                a decimal centered tab in a word processor, to help align
!                columns of number on a decimal point, if a decimal point
!                is present.
!
!    pposend_    Integer variable giving the ending column of the next
!                number or quoted character value to be written.  Used to
!                pad with zeros or blanks.
!
!    pposnam_    Integer variable giving the starting column of the next
!                name or comment or data block to be written.
!
!    pposval_    Integer variable giving the starting column of the next
!                data value to be written by pchar_, pnumb_ or pnumd_.
!                Also used to set the position of the initial "loop_"
!                in a ploop_ call or to set the position of a terminal "save_"
!                for a save frame in a pdata_ call for which saveo_ is .true.
!
!    posdec_     Integer variable giving the position of the decimal point
!                for the last number read, if a decimal point was present.
!
!    posend_     Integer variable giving the ending column of the last
!                data value read, not including a terminal quote.
!
!    posnam_     Integer variable giving the starting column of the last
!                name or comment or data block read.
!
!    posval_     Integer variable giving the starting column of the last
!                data value read.  Also reports the column of the
!                terminal "save_" of a save frame.
!
!    pquote_     Character variable giving the quotation symbol to be
!                used for the next string written, or the comment
!                flag for the next comment written.
!
!    precn_      Integer variable:  Reports the record number of the last
!                line written to the output cif.  Set to zero by init_.  Also
!                set to zero by pfile_ and close_ if the output cif file name
!                was not blank.
!
!    ptabx_      Logical variable signals tab character expansion to blanks
!                during the creation of a CIF. The default is .true.
!
!    quote_      Character variable giving the quotation symbol found
!                delimiting the last string read or the comment flag
!                for the last comment read.  The possible valid values
!                are '''', '"', ';', '''''''', and '"""'.
!                The treble quotes are recognized only if rdtq_ is .true.
!
!    rdbrc_      Logical variable:  control recognition of { ... } constructs
!                on read.  The default is .false.
!
!    rdbkt_      Logical variable:  controls recognition of [ ... ] constructs
!                on read.  The default is .false.
!
!    rdprn_      Logical variable:  controls recognition of ( ... ) constructs
!                on read.  The default is .false.
!
!    rdtq_       Logical variable:  controls recognition of """ ... """ and
!                ''' ... ''' constructs on read.  The default is .false.
!
!    rdrcqt_     Logical variable:  controls recognition of trailing punctuation
!                after a closing quote.  If .true. a closing quotation mark is
!                recognized immediately, no matter what follows the closing
!                quoation mark (the CIF 2 convention).  If .false., a closing
!                quotation mark is only effective if followed by a blank, or,
!                in bracketed constructs by a blank, a colon, a comma or 
!                the closing bracket.
!
!    recbeg_     Integer variable:  Gives the record number of the first
!                record to be used.  May be changed by the user to restrict
!                access to a CIF.
!
!    recend_     Integer variable:  Gives the record number of the last
!                record to be used.  May be changed by the user to restrict
!                access to a CIF.
!
!    recn_       Integer variable:  Reports the record number of the last
!                line read from the direct access copy of the input cif.
!
!    save_       Logical variable signals that the current data block
!                is actually a save-frame (.true. for a save-frame).
!
!    saveo_      Logical variable signals that the output data block from
!                pdata_ is actually a save-frame (.true. for a save-frame).
!
!    strg_       Character*(MAXBUF) variable: the current data item.
!
!    tabl_       Logical variable signals tab-stop alignment of output
!                during the creation of a CIF. The default is .true.
!
!    tabx_       Logical variable signals tab character expansion to blanks
!                during the reading of a CIF. The default is .true.
!
!    tbxver_     Character*32 variable: the CIFtbx version and date
!                in the form 'CIFtbx version N.N.N, DD MMM YY '
!
!    text_       Logical variable signals if another text line or is present.
!
!    type_       Character*4 variable: the data type code (see test_).
!
!    ttype_      Character*4 variable: the list, array, tuple or table type code (see test_).
!
!    unfold_     Logical variable signals that input lines are to be
!                unfolded before presentation of data.  The default
!                is .false.
!
!    xmlout_     Logical variable:  Set by the user to change the output
!                style to XML conventions.  Note that this is not a
!                cml output, but a literal translation from the input CIF.
!                The default is .false.
!
!    xmlong_     Logical variable:  Set by the user to change the style of
!                xml output if xmlout_ is .true.  When .true. (the default)
!                xml tag names are the full CIF tag names with the leading
!                '_' removed.  When .false. an attempt is made to strip
!                the leading category name as well.
!
!
!_____________________________________________________________________________
!
!
! >>>>>> Set the device numbers.
!
         function init_(devcif,devout,devdir,deverr)
!
         logical   init_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         integer   devcif,devout,devdir,deverr
         integer   ii,kdig
         real      ytest
         double precision ztest
         double precision tbxxdble
         real      tbxxsngl
!
         init_=.true.
         cifdev=devcif
         outdev=devout
         dirdev=devdir
         errdev=deverr

         recn_=0
         precn_=0
         plcat = ' '
         plxcat = ' '
         plhead(1) = ' '
         plxhead(1) = ' '
         pdblok = ' '
         ploopn = 0
         nstable = 0
         nivt = 0
!
!        recompute decimal single precision precision
!        This is found by computing the smallest power of
!        10 which, when added to 1, produces a change
!        and then backing off by 1
!
         decprc = .1
         do ii = 1,8
         ytest = tbxxsngl(1.+decprc/10.)
         if (ytest.eq.1.) go to 100
         decprc = decprc/10.
         enddo
100      continue
         decprc=decprc*10.
!
!        recompute decimal double precision precision
!
         kdig = 1
         dpprc = .1D0
         do ii = 1,17
         ztest = tbxxdble(1.D0+dpprc/10.)
         if (ztest.eq.1.D0) go to 200
         dpprc = dpprc/10.D0
         kdig = kdig+1
         enddo
200      continue
         dpprc=dpprc*10.D0
         write(ndpfmt,'(5h(d30.,i2,1h))') kdig-1
!
!        recompute decimal single precision minimum power of ten
!
         decmin = .1
         do ii = 1,39
         ytest = decmin/10.
         if (ytest.eq.0.) go to 300
         decmin = decmin/10.
         enddo
300      continue
!
!        recompute decimal double precision minimum power of 10
!        and its log base 10 (minexp)
!
         dpmin = .1D0
         minexp = -1
         do ii = 1,309
         ztest = dpmin/10.
         if (ztest.eq.0.D0) go to 400
         dpmin = dpmin/10.D0
         minexp = minexp-1
         enddo
400      continue
         call clearfp
         return
         end
!
!
! >>>>>> Function to defeat the optimizer
!
!     
         function tbxxdble(x)
         double precision x
         double precision tbxxdble
         tbxxdble = x
         return
         end
!
!
! >>>>>> Function to defeat the optimizer
!
!     
         function tbxxsngl(x)
         real x
         real tbxxsngl
         tbxxsngl = x
         return
         end
!
!
!
!
!
! >>>>>> Read a CIF dictionary and prepare for checks
!
         function dict_(fname,checks)
!
         logical   dict_
         logical   ocif_
         logical   data_
         logical   charnp_
         logical   test_
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical   tbxxnewd, tbxxoldd
         logical   nresult
         character fname*(*),checks*(*)
         character temp*(MAXBUF)
         character codes(11)*5,name*(MAXBUF),bxname*(NUMCHAR)
         character bpname*(NUMCHAR)
         character bcname*(NUMCHAR),bname*(NUMCHAR)
         character baname*(NUMCHAR),ganame*(NUMCHAR),btname*(NUMCHAR)
         character batag*(NUMCHAR)
         character mcstrg*(NUMCHAR)
         character riname*(NUMCHAR),rfname*(NUMCHAR)
         character xdicnam*(NUMCHAR)
         character xdicver*(NUMCHAR)
         character xmtoken*(NUMCHAR),xmtarg*(XMLCHAR),xmtyp*(NUMCHAR)
         character xxxtemp*(NUMCHAR)
         character*3 ovchk, otchk
         integer   nrecds,recends,recbegs
         integer   lchecks,lbpname,lbcname,lbaname,lbname
         integer   kdict,ifind,jfind,iafind,ick
         integer   i,j,nmatch,mycat,ksmatch,ii,jj,idstrt,kdup
         integer   nmycat,ixmtyp,nxmc,kxmc
         integer   lstrg,lxmtoken,lxmtarg,lxmtyp,kvrtp,kstrg,sindex
         integer   lbloc,kivt

!
!        Control flags for matching categories, names and types
!
!        icloop is the loop number of the block for the
!        current category
!        ictype is the type of the current category
!          0 - none found yet
!          1 - _item.category_id             (DDL2)
!          2 - _category                     (DDL1)
!          3 - _category.id                  (DDL2)
!          4 - _name.category_id             (DDLm)
!        the last ictype entry is not a type, but a tag
!        whose value may specify that this is a category
!        with the category name given under intype
!          5 - _definition.scope             (DDLm)
!        inloop is the loop number of the block for the
!        current name
!        intype is the type of the current name
!          0 - none found yet
!          1 - _item.name                    (DDL2)
!          2 - _name                         (DDL1)
!          3 - _definition.id                (DDLm)
!        ialoop is the loop number of the block for the
!        current alias
!        iatype is the type for the current alias
!          0 - none found yet
!          1 - _item_aliases.alias_name      (DDL2)
!          2 - _aliases.definition_id        (DDL2)
!        imloop is the loop number of the block for the
!        current parent
!        imtype is the type for a mandatory item
!          0 - none found yet
!          1 - _item.mandatory_code          (DDL2)
!          2 - _category_mandatory.item_id   (DDLm)
!        iptype is the type for the current parent
!          0 - none found yet
!          1 - _item_linked.parent_name      (DDL2)
!          2 - _item_link_parent             (DDL1)
!          3 - _category.parent_id           (DDLm)
!          4 - _name.linked_item_id          (DDLm)
!        itloop is the loop number of the block for the
!        current type
!        ittype is the type of the current type
!          0 - none found yet
!          1 - _item_type.code               (DDL2)
!          2 - _type                         (DDL1)
!          3 - _type.contents                (DDLm)
!        iritype is the type of the current related item
!          0 - none found yet
!          1 - _item_related.related_name    (DDL2)
!          2 - _related_item                 (DDL1)
!          3 - _type.purpose                 (DDLm)
!        irftype is the type of the current related item function
!          0 - none found yet
!          1 - _item_related.function_code   (DDL2)
!          2 - _related_function             (DDL1)
!          3 - _type.purpose                 (DDLm)
!

         integer icloop,ictype,inloop,intype,ialoop,iatype,             &
     & imloop,imtype,iptype,itloop,ittype,                              &
     & iritype,irftype,icktype
!
         character*4 map_type(19),map_to(19),mapped
         character*(NUMCHAR) dt(2),dv(2),ct(5),nt(3),at(2),tt(3)
         character*(NUMCHAR) ri(3),rf(3),ck(4),pt(4),pc(2),mc(3)
         character*(NUMCHAR) ve(3),vr(4)
         data map_type                                                  &
     &   /'floa','int ','yyyy','symo','ucha','ucod','name','idna',      &
     &    'any ','code','line','ulin','atco','fax ','phon','emai',      &
     &    'real','inte','coun'/
         data map_to                                                    &
     &   /'numb','numb','char','char','char','char','char','char',      &
     &    'char','char','char','char','char','char','char','char',      &
     &    'numb','numb','numb'/
         data ri                                                        &
     &      /'_item_related.related_name      ',                        &
     &       '_related_item                   ',                        &
     &       '_type.purpose                   '/
         data rf                                                        &
     &      /'_item_related.function_code     ',                        &
     &       '_related_function               ',                        &
     &       '_type.purpose                   '/
         data dt                                                        &
     &      /'_dictionary.title               ',                        &
     &       '_dictionary_name                '/
         data dv                                                        &
     &      /'_dictionary.version             ',                        &
     &       '_dictionary_version             '/
         data ct                                                        &
     &      /'_item.category_id               ',                        &
     &       '_category                       ',                        &
     &       '_category.id                    ',                        &
     &       '_name.category_id               ',                        &
     &       '_definition.scope               '/
         data nt                                                        &
     &      /'_item.name                      ',                        &
     &       '_name                           ',                        &
     &       '_definition.id                  '/
         data at                                                        &
     &      /'_item_aliases.alias_name        ',                        &
     &       '_aliases.definition_id          '/
         data tt                                                        &
     &      /'_item_type.code                 ',                        &
     &       '_type                           ',                        &
     &       '_type.contents                  '/
         data ck                                                        &
     &      /'_category_key.name              ',                        &
     &       '_list_reference                 ',                        &
     &       '_category_key.generic           ',                        &
     &       '_category_key.primitive         '/
         data pt                                                        &
     &      /'_item_linked.parent_name        ',                        &
     &       '_item_link_parent               ',                        &
     &       '_category.parent_id             ',                        &
     &       '_name.linked_item_id            '/
         data pc                                                        &
     &      /'_item_linked.child_name         ',                        &
     &       '_item_link_child                '/
         data mc                                                        &
     &      /'_item.mandatory_code            ',                        &
     &       '_mandatory                      ',                        &
     &       '_category_mandatory.item_id     '/
         data ve                                                        &
     &      /'_item_enumeration.value         ',                        &
     &       '_enumeration                    ',                        &
     &       '_enumeration_set.state          '/
         data vr                                                        &
     &      /'_item_range.minimum             ',                        &
     &       '_enumeration_range              ',                        &
     &       '_item_range.maximum             ',                        &
     &       '_enumeration.range              '/

!
         data codes /'valid','dtype','reset','close',                   &
     &       'catck','catno','nodup','final','first',                   &
     &       'parck','parno'/
!
         nrecds=nrecd
         recbegs=recbeg_
         recends=recend_
         if(append_) then
           recbeg_=nrecd
         endif
!
!        Initialize kdup to 0 ('final')
!
         kdup = 0
!
!        initialize both xdicnam and xdicver to blank
!
         xdicnam = ' '
         xdicver = ' '
!
!        preserve entry values of tcheck and vcheck in case dict fails
!
         otchk = tcheck
         ovchk = vcheck
!
!....... Are the codes OK
!
         lchecks=min(len(temp),len(checks))
         call tbxxnlc(temp(1:lchecks),checks)
         i=0
120      i=i+1
         if(i.ge.lchecks)            goto 190
         if(temp(i:i).eq.' ')        goto 120
         do 150 j=1,11
         if(temp(i:i+4).eq.codes(j)) goto 170
150      continue
         dict_=.false.
         goto 500
170      i=i+4
         if(j.eq.1) then
           vcheck='yes'
           goto 120
         endif
         if(j.eq.2) then
           tcheck='yes'
           goto 120
         endif
         if(j.eq.3) then
           vcheck = 'no '
           tcheck = 'no '
           goto 120
         endif
         if(j.eq.4) then
           vcheck = 'no '
           tcheck = 'no '
           catchk = 'yes'
           ndcname = 0
           ndict = 0
           if(nname.gt.0) then
           do 180 i = 1,nname
             dtype(i)=' '
             dxtyp(i)=' '
             cindex(i)=0
             ddict(i)=0
180        continue
           endif
           dict_=.true.
           goto 500
         endif
         if (j.eq.5) then
           catchk = 'yes'
           goto 120
         endif
         if (j.eq.6) then
           catchk = 'no '
           goto 120
         endif
         if (j.eq.10) then
           parchk = 'yes'
           goto 120
         endif
         if (j.eq.11) then
           parchk = 'no '
           goto 120
         endif
         kdup=j-8
         goto 120
!
!        if no category names have been loaded, clean up
!        the hash table for dictionary category names
!
190      if(ndcname.eq.0) then
           call hash_init(dcname,dcchain,NUMDICT,ndcname,dchash,        &
     &     NUMHASH)
         endif
!
!        if no dictionary names have been loaded, clean up
!        the hash table for dictionary names
!
         if(ndict.eq.0) then
           call hash_init(dicnam,dicchain,NUMDICT,ndict,dichash,        &
     &     NUMHASH)
         endif
         idstrt=ndict
!
!....... Open and store the dictionary
!
         dict_=.true.
         if(fname.eq.' ')            goto 500
         if(nname.gt.0) call tbxxerr(' Dict_ must precede ocif_')
         dict_=ocif_(fname)
         if(.not.dict_)              goto 500
         dictfl='yes'
!
!        At this point is is proper to update xdicnam to fname
!
         xdicnam = fname
!
!....... Loop over data blocks; extract _name's, _type etc.
!
200      if(.not.data_(' '))         goto 400
         lbloc = lastnb(bloc_)
         if(bloc_(1:1).eq.'_'.or.glob_.or.bloc_.eq.' ') then
           call tbxxclc(bname,lbname,bloc_(1:lbloc),lbloc)
         else
           call tbxxclc(bname,lbname,'_'//bloc_(1:lbloc),lbloc+1)
         endif
!
!        see if this is a dictionary defining block
!
         do i = 1,2
           if(charnp_(dt(i),name,lstrg)) then
             xdicnam = name(1:lstrg)
             do j = 1,2
               if(test_(dv(j))) then
                 xdicver = strg_(1:max(1,long_))
                 goto 200
               endif
             enddo
             goto 200
           endif
         enddo
!
!dbg     WRITE(6,*) ndict,bloc_
!
!        Analyze loop structure for categories, names, types and parents
!
!
!        initalize loop info
!
         icloop = -1
         inloop = -1
         ialoop = -1
         imloop = -1
         itloop = -1
         ictype = 0
         intype = 0
         iatype = 0
         imtype = 0
         iptype = 0
         ittype = 0
         iritype = 0
         irftype = 0
         icktype = 0
         ixmtyp = 0
         bcname = ' '
         bpname = ' '
         lbcname = 1
         lbpname = 1
         baname = ' '
         batag = ' '
         lbaname = 1
         btname = ' '
         mycat=0
         loop_=.false.
         loopnl=0
         nmatch=0
         ksmatch=0
         riname = ' '
         rfname = ' '
!
!        Pick up category_keys and list_references
!
         do i = 1,4
210        if(charnp_(ck(i),name,lstrg)) then
             if (icktype.ne.0 .and. icktype.ne.i)                       &
     &         call tbxxwarn                                            &
     &         (' Multiple DDL 1, 2 or m related key definitions ')
             icktype = i
             if (tbxxnewd(name(1:lstrg),ick)) then
               catkey(ick) = .true.
             else
               if(.not.catkey(ick)) then
                 ifind = aroot(ick)
215              catkey(ifind) = .true.
                 ifind = alias(ifind)
                 if (ifind.ne.0) go to 215
               endif
             endif
             if (loop_) go to 210
           endif
         enddo

!
!        Process related items
!
         do i = 1,2
           if(charnp_(ri(i),name,lstrg)) then
             if (iritype.ne.0)                                          &
     &         call tbxxwarn                                            &
     &         (' Multiple DDL 1 and 2 related item definitions ')
             iritype = i
             call tbxxnlc(riname,name(1:lstrg))
!
!            Seek the matching function, may be in the same loop or not
!
             if(charnp_(rf(i),name,lstrg)) then
               if (irftype.ne.0)                                        &
     &           call tbxxwarn                                          &
     &           (' Multiple DDL 1 and 2 related item functions ')
               irftype = i
               call tbxxnlc(rfname,name(1:lstrg))
             endif
           endif
         enddo
         loop_ = .false.
         loopnl = 0
!
!        Process categories
!
         do i = 1,5
           if(charnp_(ct(i),name,lstrg)) then
             if(i.eq.5) then
!
!              if this is a DDLm _defintion.scope with a value of
!              category, we need to get the name from _defintion.id
!
               call tbxxnlc(bcname,name(1:lstrg))
               if(bcname.eq.'category') then
                 if(.not.charnp_(nt(3),name,lstrg)) then
                   call tbxxwarn(                                       &
     &             ' DDLm category defintion without _definition.id ')
                 else
                   go to 216
                 endif
               endif
             endif

             if(ictype.ne.0)                                            &
     &         call tbxxwarn(                                           &
     &           ' Multiple DDL 1, 2 or m category definitions ')
             ictype = i
             if(loop_) icloop = loopnl
             call tbxxnlc(bcname,name(1:lstrg))
             lbcname=long_
             nmycat = ndcname+1
             call hash_store(bcname(1:long_),                           &
     &         dcname,dcchain,NUMDICT,ndcname,dchash,NUMHASH,mycat)
             if(mycat.eq.0) then
               call tbxxerr(' Dictionary category names > NUMDICT ')
             endif
             if (mycat.eq.nmycat) then
               ccatkey(mycat) = 0
               xmcind(mycat)=0
             endif
!
!            if this is not a loop of categories, we expect a match
!            against the block name, unless we are doing replacements
!
             if(.not.loop_) then
               if(ictype.eq.1) then
                 if(bname(1:min(lbname,lbcname+2)).ne.                  &
     &            '_'//bcname(1:lbcname)//'.'                           &
     &            .and. catchk.eq.'yes'                                 &
     &            .and. (rfname(1:7).ne.'replace')) then
                 call tbxxwarn(' Category id does not match block name')
                 endif
               else
                 if(ictype.eq.2) then
                   if(bcname.ne.'dictionary_definition' .and.           &
     &                bcname.ne.'category_overview') then
                   if(bname(1:min(lbname,lbcname+2)).ne.                &
     &               '_'//bcname(1:lbcname)//'_') then
                   if(bname(1:min(lbname,lbcname+1)).ne.                &
     &               '_'//bcname(1:lbcname)                             &
     &            .and. catchk.eq.'yes'                                 &
     &            .and. (rfname(1:7).ne.'replace')) then
                   call tbxxwarn(                                       &
     &               ' Category id does not match block name')
                   endif
                   endif
                   endif
                 endif
               endif
             endif
           endif
           loop_ = .false.
           loopnl = 0
         enddo
!
!        Process XML translations
!
216      loop_ = .false.
         loopnl = 0
         if(charnp_('_xml_mapping.token',xmtoken,lxmtoken)) then
230        if(charnp_('_xml_mapping.token_type',xmtyp,lxmtyp)) then
             if(charnp_('_xml_mapping.target',xmtarg,lxmtarg)) then
               if (xmnxlat.ge.XMLDEFS) then
                 call tbxxerr(' XML translations > XMLDEFS')
               else
                 xmnxlat=xmnxlat+1
                 xmlate(xmnxlat)=xmtarg(1:lxmtarg)
               endif
               if (xmtyp.eq.'data') then
                 ixmtyp = 1
                 if (xmdata.eq.0) then
                   xmdata = xmnxlat
                 else
                   call tbxxwarn(' XML duplicate DATA_ translation')
                 endif
               endif
               if (xmtyp(1:lxmtyp).eq.'category') then
                 ixmtyp = 2
                 nxmc = ndcname+1
                 call tbxxnlc(xxxtemp,xmtoken(1:lxmtoken))
                 call hash_store(xxxtemp,                               &
     &           dcname,dcchain,NUMDICT,ndcname,dchash,NUMHASH,kxmc)
                 if( kxmc.eq.nxmc) then
                   ccatkey(kxmc) = 0
                   xmcind(kxmc) = xmnxlat
                 else
                   if (xmcind(kxmc).ne.0) then
                     call tbxxwarn(                                     &
     &                 ' XML duplicate category translation')
                   else
                     xmcind(kxmc) = xmnxlat
                   endif
                 endif
               endif
               if (xmtyp.eq.'item') then
                 ixmtyp = 3
                 if (tbxxnewd(xmtoken(1:lxmtoken),ifind)) then
                   xmindex(ifind) = xmnxlat
                 else
                   if (xmindex(ifind).ne.0) then
                     call tbxxwarn(' XML duplicate item translation')
                   else
                     ifind = aroot(ifind)
 235                 xmindex(ifind) = xmnxlat
                     ifind = alias(ifind)
                     if (ifind.ne.0) go to 235
                   endif
                 endif
               endif
               if(loop_) then
                 if(charnp_('_xml_mapping.token',xmtoken,lxmtoken)) then
                   go to 230
                 else
                   call tbxxerr(' XML dictionary logic error')
                 endif
               endif
             else
               call tbxxerr(' XML target missing')
             endif
           else
             call tbxxerr(' XML token_type missing')
           endif
         else
           xmtoken = bname(1:lbname)
           lxmtoken=lbname
           if(charnp_('_xml_mapping.token_type',xmtyp,lxmtyp)) then
             if(charnp_('_xml_mapping.target',xmtarg,lxmtarg)) then
               if (xmnxlat.ge.XMLDEFS) then
                 call tbxxerr(' XML translations > XMLDEFS')
               else
                 xmnxlat=xmnxlat+1
                 xmlate(xmnxlat)=xmtarg(1:lxmtarg)
               endif
               if (xmtyp(1:lxmtyp).eq.'data') then
                 ixmtyp = 1
                 if (xmdata.eq.0) then
                   xmdata = xmnxlat
                 else
                   call tbxxwarn(' XML duplicate DATA_ translation')
                 endif
               endif
               if (xmtyp.eq.'category') then
                 ixmtyp = 2
                 nxmc = ndcname+1
                 call tbxxnlc(xxxtemp,xmtoken(1:lxmtoken))
                 call hash_store(xxxtemp,                               &
     &           dcname,dcchain,NUMDICT,ndcname,dchash,NUMHASH,kxmc)
                 if( kxmc.eq.nxmc) then
                   ccatkey(kxmc) = 0
                   xmcind(kxmc) = xmnxlat
                 else
                   if (xmcind(kxmc).ne.0) then
                     call tbxxwarn(                                     &
     &                 ' XML duplicate category translation')
                   else
                     xmcind(kxmc) = xmnxlat
                   endif
                 endif
               endif
               if (xmtyp.eq.'item') then
                 ixmtyp = 3
                 if (tbxxnewd(xmtoken(1:lxmtoken),ifind)) then
                   xmindex(ifind) = xmnxlat
                 else
                   if (xmindex(ifind).ne.0) then
                     call tbxxwarn(' XML duplicate item translation')
                   else
                     ifind = aroot(ifind)
 240                 xmindex(ifind) = xmnxlat
                     ifind = alias(ifind)
                     if (ifind.ne.0) go to 240
                     xmindex(ifind) = xmnxlat
                   endif
                 endif
               endif
               if(loop_) then
                 call tbxxerr(' XML dictionary logic error')
               endif
             else
               call tbxxerr(' XML target missing')
             endif
           endif
         endif
!
!        Process names
!
         bxname = ' '
         do i = 1,3
         if(charnp_(nt(i),name,lstrg)) then
           if(intype.ne.0)                                              &
     &       call tbxxwarn(                                             &
     &         ' Multiple DDL 1 and 2 or m name definitions ')
           intype = i
           call tbxxnlc(bxname,name(1:lstrg))
           if(loop_) inloop = loopnl
         endif
         loop_ = .false.
         loopnl=0
         enddo
         if(intype.eq.0.and.ictype.lt.3.and.(.not.glob_)                &
     &     .and.bname(1:lbname).ne.' '.and.ixmtyp.eq.0)                 &
     &     call tbxxwarn (' No name defined in block')
         loop_ = .false.
         if(charnp_(at(1),name,lstrg)) then
           iatype=1
           call tbxxnlc(baname,name(1:lstrg))
           batag = name(1:lstrg)
           lbaname = lstrg
           if(loop_) ialoop = loopnl
         endif
         loop_ = .false.
         loopnl=0
         mcstrg = "no"
         if(ictype.ne.3) then
           do i=1,3
             if(charnp_(tt(i),name,lstrg)) then
               if(ittype.ne.0)                                          &
     &           call tbxxwarn(                                         &
     &             ' Multiple DDL 1 and 2 type definitions ')
               ittype = i
               call tbxxnlc(btname,name(1:lstrg))
               if(loop_) itloop = loopnl
             endif
             loop_ = .false.
             loopnl=0
           enddo
           do i = 1,2
             if(charnp_(mc(i),name,lstrg)) then
               if (imtype.ne.0)                                         &
     &           call tbxxwarn(' Multiple DDL 1 and 2 mandatory codes ')
               imtype = i
               call tbxxnlc(mcstrg,name(1:lstrg))
               if (loop_) imloop = loopnl
             endif
             loop_ = .false.
             loopnl=0
           enddo
         endif
!
!        Now test for consistent combinations
!
         if(inloop.ne.-1) then
           if(icloop.ne.-1.and.icloop.ne.inloop                         &
     &            .and. catchk.eq.'yes')                                &
     &       call tbxxwarn(                                             &
     &       ' Categories and names in different loops')
           if(iatype.ne.0.and.ialoop.ne.inloop) then
             if(ialoop.eq.-1) then
               if(bxname.ne.bname(1:lbname))                            &
     &          call tbxxwarn(                                          &
     &         ' One alias, looped names, linking to first')
             else
               call tbxxwarn(                                           &
     &         ' Aliases and names in different loops '                 &
     &         //' only using first alias ')
             endif
           endif
           if(itloop.ne.-1.and.itloop.ne.inloop)                        &
     &       call tbxxwarn(                                             &
     &       ' Types and names in different loops')
           if(imloop.ne.-1.and.imloop.ne.inloop)                        &
     &       call tbxxwarn(                                             &
     &       ' Mandatory codes and names in different loops')
         else
           if(icloop.ne.-1)                                             &
     &       call tbxxwarn(                                             &
     &         ' Multiple categories for one name')
           if(itloop.ne.-1)                                             &
     &       call tbxxwarn(                                             &
     &         ' Multiple types for one name')
           if(imloop.ne.-1)                                             &
     &       call tbxxwarn(                                             &
     &         ' Multiple madatory codes for one name')
         endif
!
!        Pick up parents
!
         do i = 1,2
220        if(charnp_(pt(i),name,lstrg)) then
             if (iptype.ne.0 .and. iptype.ne.i)                         &
     &         call tbxxwarn                                            &
     &         (' Multiple DDL 1 and 2 parent definitions ')
             iptype = i
             call tbxxnlc(bpname,name(1:lstrg))
             lbpname=long_
!
!            Seek the matching child, may be in the same loop or not
!
             if (charnp_(pc(i),name,lstrg)) then
               nresult = tbxxnewd(name(1:lstrg),ifind)
               nresult = tbxxnewd(bpname(1:lbpname),dpindex(ifind))
               bpname = ' '
               lbpname = 1
             endif
             if (loop_) go to 220
           endif
         enddo

!
!        Now we need to process value enumerations and ranges
!        and load them into item value table
!
         if (tcheck .eq. 'yes' .and. bxname.ne.' ') then
         loop_ = .false.
         nresult = tbxxnewd(bxname,ifind)

         do i = 1,2
5400       if(charnp_(ve(i),name,lstrg) .and. nivt.lt.NUMIVALS) then
             call tbxxsstb(name(1:lstrg),sindex)
             if (sindex.gt.0) then
               if (deindex(ifind).eq.0) then
                 deindex(ifind)=nivt+1
               else
                 kivt = deindex(ifind)
5410             if (ivtnxt(kivt).ne.0) then
                   kivt = ivtnxt(kivt)
                   go to 5410
                 endif
                 ivtnxt(kivt)=nivt+1
               endif
               nivt = nivt+1
               ivtnxt(nivt)=0
               ivtvet(nivt)=0
               ivtsbp(nivt)=sindex
             endif
           endif
           if (loop_) go to 5400
         enddo


         do i = 1,2
         loop_ = .false.
5420     strg_=' '
         long_=1
         nresult = test_(vr(i))
         if (strg_(1:long_).ne.' '.and.type_.eq.'null')                 &
     &     nresult = .true.
         if (nresult .and. nivt.lt.NUMIVALS) then
           nresult = charnp_(vr(i),name,lstrg)
           if (type_.ne.'char'.and.type_.ne.'numb') then
             name = '.'
             lstrg = 1
           endif
           kvrtp = -1
           if(i.eq.1 .and. lstrg<len(name)-2) then
             strg_=' '
             long_=1
             nresult = test_(vr(3))
             if (strg_(1:long_).ne.' '.and.                             &
     &         type_.eq.'null') nresult = .true.
             if (nresult) then
               nresult = charnp_(vr(3),                                 &
     &           name(lstrg+2:len(name)),kstrg)
               if (type_.ne.'char'.and.type_.ne.'numb') then
                 name(lstrg+2:len(name)) = '.'
                 kstrg = 1
               endif
               if (name(1:lstrg).ne.name(lstrg+2:lstrg+1+kstrg))        &
     &           kvrtp = 1
               name(lstrg+1:lstrg+1)=':'
               lstrg = lstrg+kstrg+1
               endif
             endif
             if (name(1:lstrg).eq.'.:.') then
               loop_=.false.
             else
               call tbxxsstb(name(1:lstrg),sindex)
               if (sindex.gt.0) then
                 if (deindex(ifind).eq.0) then
                   deindex(ifind)=nivt+1
                 else
                   kivt = deindex(ifind)
5430               if (ivtnxt(kivt).ne.0) then
                     kivt = ivtnxt(kivt)
                     go to 5430
                   endif
                   ivtnxt(kivt)=nivt+1
                 endif
                 nivt = nivt+1
                 ivtnxt(nivt)=0
                 ivtvet(nivt)=kvrtp
                 ivtsbp(nivt)=sindex
               endif
               if(loop_) go to 5420
             endif
           endif
         enddo
         endif

!
!        This is the main loop
!
250      if(ictype.eq.5.or.intype.eq.0) goto 200
         if(.not.charnp_(nt(intype),name,lstrg)) goto 200
         kdict=ndict+1
251      nresult = tbxxnewd(name(1:lstrg),ifind)
         if (bpname .ne. ' ') then
           nresult=tbxxnewd(bpname(1:lbpname),dpindex(ifind))
           bpname = ' '
           lbpname = 1
         endif
         nresult = tbxxoldd(bxname,jfind)
         if (nresult.and.jfind.ne.ifind.and.deindex(ifind).eq.0)        &
     &     deindex(ifind) = deindex(jfind)
         if(ifind.le.idstrt) then
           if (kdup .lt. 0) then
             call tbxxerr(' Duplicate name in dictionary '//            &
     &       dictag(ifind)(1:lastnb(dictag(ifind))))
           endif
           if (kdup .gt.0) go to 254
           dicnam(ifind)=char(0)
           goto 251
254        continue
         endif
         if(dicnam(ifind).eq.bname(1:lbname)) nmatch=ifind
         if(dicnam(ifind)(1:lbname).eq.bname(1:lbname)) ksmatch=ifind
!dbg     if(dicnam(ifind).ne.bname(1:lbname))
!dbg *   call tbxxwarn (' Name mismatch: '//dicnam(ifind)//bname(1:lbname))
         if(inloop.ge.0)then
!
!          We are in a loop of names.  If it is the same loop as
!          for categories, we need to extract the matching category
!
           if(inloop.eq.icloop) then
             mycat=0
             if(charnp_(ct(ictype),name,lstrg)) then
               call tbxxnlc(bcname,name(1:lstrg))
               lbcname=lstrg
               nmycat=ndcname+1
               call hash_store(bcname,                                  &
     &         dcname,dcchain,NUMDICT,ndcname,dchash,NUMHASH,mycat)
               if(mycat.eq.0) then
                 call tbxxerr(' Dictionary category names > NUMDICT ')
               endif
               if(mycat.eq.nmycat) ccatkey(mycat)=0
             endif
           endif
!
!          If it is the same loop as for types, we need to extract
!          the matching type
!
           if(inloop.eq.itloop) then
             btname=' '
             if(charnp_(ct(ittype),name,lstrg)) then
               call tbxxnlc(btname,name(1:lstrg))
             endif
           endif
!
!          If it is the same loop as for mandatory codes, we need to extract
!          the matching mandatory
!
           if(inloop.eq.imloop) then
             mcstrg='no'
             if(charnp_(mc(imtype),name,lstrg)) then
               call tbxxnlc(mcstrg,name(1:lstrg))
             endif
           endif
!
!          If it is the same loop as for aliases, we need to extract
!          the matching alias
!
           if(inloop.eq.ialoop) then
             baname=' '
             batag=' '
             if(charnp_(at(1),name,lstrg)) then
               call tbxxnlc(baname,name(1:lstrg))
               batag = name(1:lstrg)
               lbaname = lstrg
             endif
           endif
         endif
!
!        now we have a name stored in dicnam at location ifind
!        the index of the category in mycat, the type in btname,
!        the alias in baname, and the mandatory code in mcstrg
!
!        First verify match between the name and category, if
!        we have one, or extract from the block name
!
         if (mycat.eq.0) then
         if (dcindex(ifind).eq.0) then
           if (dicnam(ifind).eq.bloc_) then
             call tbxxcat(dicnam(ifind),bcname,lbcname)
!dbg         call tbxxwarn(' Extracting category name from block name '
!dbg *       //bloc_(1:max(1,lastnb(bloc_))))
             if(bcname(1:1).ne.' ') then
               ictype = 1
               nmycat = ndcname+1
               call hash_store(bcname,                                  &
     &         dcname,dcchain,NUMDICT,ndcname,dchash,NUMHASH,mycat)
               if(mycat.eq.0) then
                 call tbxxerr(' Dictionary category names > NUMDICT ')
               endif
               if (mycat.eq.nmycat) then
                 ccatkey(mycat) = 0
                 xmcind(mycat) = 0
               endif
             else
               if(catchk.eq.'yes')                                      &
     &         call tbxxwarn(' No category defined in block '           &
     &       //bloc_(1:max(1,lastnb(bloc_)))//' and name '              &
     &       //dicnam(ifind)(1:max(1,lastnb(dicnam(ifind))))            &
     &       //' does not match')
             endif
           endif
         endif
         else
         if (bcname(1:lbcname).ne.'dictionary_definition' .and.         &
     &     bcname(1:lbcname).ne.'category_overview') then
           if (dicnam(ifind)(1:lbcname+1).ne.'_'//bcname(1:lbcname)     &
     &        .or.( dicnam(ifind)(lbcname+2:lbcname+2).ne.'_' .and.     &
     &          dicnam(ifind)(lbcname+2:lbcname+2).ne.'.' .and.         &
     &          dicnam(ifind)(lbcname+2:lbcname+2).ne.' ' )) then
                if (catchk.eq.'yes'.and.rfname(1:7).ne.'replace')       &
     &          call tbxxwarn(' Item name '//                           &
     &          dicnam(ifind)(1:max(1,lastnb(dicnam(ifind))))//' '//    &
     &       ' does not match category name '//bcname(1:lbcname))
           endif
         endif
         endif
!
!        We will need the type in what follows.  cif_mm.dic defines
!        some higher level types.  We map them to primitive types
!
         mapped = btname(1:4)
         do i = 1,19
           if (btname(1:4).eq.map_type(i)) mapped = map_to(i)
         enddo
         if (mapped.ne.'char' .and.                                     &
     &       mapped.ne.'text' .and.                                     &
     &       mapped.ne.'null' .and.                                     &
     &       mapped.ne.'numb' .and.                                     &
     &       mapped.ne.'    ' ) then
             if (tcheck .eq. 'yes') then
               call tbxxwarn (' Item type '//                           &
     &           btname(1:max(1,lastnb(btname)))//' not recognized')
             endif
             mapped = 'char'
         endif

!
!        There are two cases to consider, one if the name is new to
!        the dictionary, the other, if it is not
!
         if(ifind.eq.kdict) then
           aroot(ifind)=ifind
           alias(ifind)=0
           dcindex(ifind)=mycat
           dictyp(ifind)=mapped
           dicxtyp(ifind)=btname
           dmcode(ifind) = 0
           if (mcstrg .eq. 'yes') dmcode(ifind) = 1
           if (mcstrg .eq. 'implicit') dmcode(ifind) = -1
         else
           if(dcindex(ifind).ne.mycat) then
             if(dcindex(ifind).eq.0) then
               jfind=ifind
               if (aroot(ifind).ne.0) jfind=aroot(ifind)
255            continue
               dcindex(jfind)=mycat
               jfind=alias(jfind)
               if(jfind.ne.0) goto 255
             else
               if(mycat.ne.0.and.                                       &
     &           (vcheck.eq.'yes'.or.tcheck.eq.'yes')                   &
     &           .and.catchk.eq.'yes')  then
                 if(rfname(1:7).ne.'replace')                           &
     &           call tbxxwarn(' Attempt to redefine category for item')
                 endif
             endif
           endif
           if(dictyp(ifind).ne.mapped .or.                              &
     &       dicxtyp(ifind).ne.btname) then
             if(dictyp(ifind).eq.' ') then
               jfind=ifind
               if (aroot(ifind).ne.0) jfind=aroot(ifind)
256            continue
               dictyp(jfind)=mapped
               dicxtyp(jfind)=btname
               jfind=alias(jfind)
               if(jfind.ne.0) go to 256
             else
               if(mapped.ne.' '.and.tcheck.eq.'yes')                    &
     &           call tbxxwarn(' Attempt to redefine type for item')
             endif
           endif
           if(dmcode(ifind).eq.0) then
             jfind = ifind
             if (aroot(ifind).ne.0) jfind = aroot(ifind)
257          continue
             dmcode(jfind) = 0
             if (mcstrg.eq.'yes') dmcode(jfind) = 1
             if (mcstrg.eq.'implicit') dmcode(jfind) = -1
             jfind=alias(jfind)
             if(jfind.ne.0) go to 257
           else
             if((mcstrg.eq.'yes' .and. dmcode(ifind).lt.0) .or.         &
     &         (mcstrg.eq.'implicit' .and. dmcode(ifind).gt.0))         &
     &         call tbxxwarn(                                           &
     &           ' Attempt to redefine mandatory code for item')
           endif
         endif
!
!        now deal with alias, if any.
!
         if(baname.ne.' ') then
           if (tbxxnewd(baname(1:lbaname),iafind)) then
             dictag(iafind)    =batag
             aroot(iafind)     =aroot(ifind)
             if(aroot(iafind).eq.0) aroot(iafind)=ifind
             catkey(iafind)    =catkey(ifind)
             alias(ifind)      =iafind
             dcindex(iafind)   =dcindex(ifind)
             dictyp(iafind)    =dictyp(ifind)
             dicxtyp(iafind)   =dicxtyp(ifind)
             xmindex(iafind)   =xmindex(ifind)
             dmcode(iafind)    =dmcode(ifind)
             dpindex(iafind)   =dpindex(ifind)
             deindex(iafind)   =deindex(ifind)
           else
             if(aroot(iafind).ne.0 .and.                                &
     &         aroot(iafind).ne.iafind) then
               if(aroot(iafind).eq.ifind .or.                           &
     &           aroot(iafind).eq.aroot(ifind)) then
                 call tbxxwarn(' Duplicate definition of same alias')
               else
                 call tbxxwarn(' Conflicting definition of alias')
               endif
             else
               if((dcindex(iafind).eq.0.or.                             &
     &           dcindex(iafind).eq.dcindex(ifind)).and.                &
     &           (dictyp(iafind).eq.' '.or.                             &
     &           (dictyp(iafind).eq.dictyp(ifind) .and.                 &
     &            dicxtyp(iafind).eq.dicxtyp(ifind)))) then
                 dcindex(iafind)   =dcindex(ifind)
                 dictyp(iafind)    =dictyp(ifind)
                 dicxtyp(iafind)   =dicxtyp(ifind)
               endif
               if(xmindex(iafind).eq.0)                                 &
     &           xmindex(iafind)=xmindex(ifind)
               if(xmindex(ifind).eq.0)                                  &
     &           xmindex(ifind)=xmindex(iafind)
               if (dmcode(iafind).eq.0)                                 &
     &           dmcode(iafind)=dmcode(ifind)
               if (dmcode(ifind).eq.0)                                  &
     &           dmcode(ifind)=dmcode(iafind)
               if (dpindex(iafind).eq.iafind                            &
     &           .and. dpindex(ifind).ne.ifind)                         &
     &           dpindex(iafind) = dpindex(ifind)
               if (dpindex(ifind).eq.ifind                              &
     &           .and. dpindex(iafind).ne.iafind)                       &
     &           dpindex(ifind) = dpindex(iafind)
               if (deindex(ifind).eq.0)                                 &
     &           deindex(ifind)=deindex(iafind)
               if (deindex(iafind).eq.0)                                &
     &           deindex(iafind)=deindex(ifind)
               aroot(iafind)     =aroot(ifind)
               if(aroot(iafind).eq.0) aroot(iafind)=ifind
               alias(ifind)      =iafind
               if (catkey(iafind)) catkey(ifind) = .true.
               if (catkey(ifind)) catkey(iafind) = .true.
             endif
           endif
         endif
         if(inloop.ge.0) then
           baname = ' '
           batag = ' '
         endif
!
         if(inloop.ge.0.and.loop_) go to 250
         if(nmatch.eq.0) then
         if ((ksmatch.eq.0.or.inloop.lt.0)                              &
     &     .and.(rfname(1:7).ne.'replace')) then
         call tbxxwarn(' No name in the block matches the block name')
         endif
         endif
!
!        check for aliases
!        we execute this loop only in the case of unlooped name
!        with looped alias
!
         if(inloop.lt.0.and.ialoop.ge.0) then
           loop_=.false.
           loopnl=0
           ganame=baname
260        if(.not.charnp_(at(iatype),name,lstrg)) goto 200
           call tbxxnlc(baname,name(1:lstrg))
           batag=name(1:lstrg)
           lbaname=lstrg
           if(baname.eq.ganame) then
             if(loop_) go to 260
             go to 200
           endif
           if(baname.ne.' ') then
             if (tbxxnewd(baname(1:lbaname),iafind)) then
             if(iafind.eq.0) call tbxxerr(' CIFdic names > NUMDICT')
               dictag(iafind)    =batag
               aroot(iafind)     =aroot(ifind)
               if(aroot(iafind).eq.0) aroot(iafind)=ifind
               catkey(iafind)    =catkey(ifind)
               alias(ifind)      =iafind
               dcindex(iafind)   =dcindex(ifind)
               dictyp(iafind)    =dictyp(ifind)
               dicxtyp(iafind)   =dicxtyp(ifind)
               xmindex(iafind)   =xmindex(ifind)
               dmcode(iafind)    =dmcode(ifind)
               dpindex(iafind)   =dpindex(ifind)
               deindex(iafind)   =deindex(ifind)
               ifind=iafind
             else
               if(aroot(iafind).ne.0 .and.                              &
     &           aroot(iafind).ne.iafind) then
                 if(aroot(iafind).eq.ifind .or.                         &
     &             aroot(iafind).eq.aroot(ifind)) then
                   call tbxxwarn(' Duplicate definition of same alias')
                 else
                   call tbxxwarn(' Conflicting definition of alias')
                 endif
               else
                 if((dcindex(iafind).eq.0.or.                           &
     &           dcindex(iafind).eq.dcindex(ifind)).and.                &
     &           (dictyp(iafind).eq.' '.or.                             &
     &           (dictyp(iafind).eq.dictyp(ifind) .and.                 &
     &            dicxtyp(iafind).eq.dicxtyp(ifind)))) then
                 dcindex(iafind)   =dcindex(ifind)
                 dictyp(iafind)    =dictyp(ifind)
                 dicxtyp(iafind)   =dicxtyp(ifind)
                 ifind=iafind
                 endif
                 if(xmindex(iafind).eq.0)                               &
     &             xmindex(iafind)=xmindex(ifind)
                 if(xmindex(ifind).eq.0)                                &
     &             xmindex(ifind)=xmindex(iafind)
                 if (dmcode(iafind).eq.0)                               &
     &             dmcode(iafind)=dmcode(ifind)
                 if (dmcode(ifind).eq.0)                                &
     &             dmcode(ifind)=dmcode(iafind)
                 if (dpindex(iafind).eq.iafind                          &
     &             .and. dpindex(ifind).ne.ifind)                       &
     &             dpindex(iafind) = dpindex(ifind)
                 if (dpindex(ifind).eq.ifind                            &
     &             .and. dpindex(iafind).ne.iafind)                     &
     &             dpindex(ifind) = dpindex(iafind)
                 if (deindex(ifind).eq.0)                               &
     &             deindex(ifind) = deindex(iafind)
                 if (deindex(iafind).eq.0)                              &
     &             deindex(iafind) = deindex(ifind)
                 aroot(iafind)     =aroot(ifind)
                 if(aroot(iafind).eq.0) aroot(iafind)=ifind
                 alias(ifind)      =iafind
                 if (catkey(iafind)) catkey(ifind) = .true.
                 if (catkey(ifind)) catkey(iafind) = .true.
               endif
             endif
           endif
           if(loop_) go to 260
         endif
         go to 200
!
400      bloc_=' '
         if (ndcname.ne.0) then
         do ii = idstrt+1,ndict
         keychain(ii) = 0
         if (aroot(ii).eq.0.and.dcindex(ii).eq.0                        &
     &     .and.catchk.eq.'yes')                                        &
     &     call tbxxwarn(' No category specified for name '//           &
     &       dicnam(ii)(1:max(1,lastnb(dicnam(ii)))))
         enddo
         endif
         do ii = idstrt+1,ndict
         if (dicxtyp(ii).eq.' ') then
           if (dpindex(ii).ne.ii                                        &
     &       .and. dicxtyp(dpindex(ii)).ne.' ') then
             dicxtyp(ii) = dicxtyp(dpindex(ii))
             dictyp(ii) = dicxtyp(dpindex(ii))(1:4)
           else
             dicxtyp(ii) = 'null'
             dictyp(ii) = 'null'
             if (tcheck.eq.'yes')  then
               jj = lastnb(dicnam(ii))
               if (jj.gt.0) then
               if (dicnam(ii)(jj:jj).ne.'_')                            &
     &         call tbxxwarn(' No type specified for name '//           &
     &           dicnam(ii)(1:max(1,lastnb(dicnam(ii)))))
               endif
             endif
           endif
         endif
         if (catkey(ii) .or. dmcode(ii).gt.0) then
           ifind = aroot(ii)
           mycat = dcindex(ifind)
           if (mycat.ne.0) then
             jj = ccatkey(mycat)
             if (jj.eq.0) then
               ccatkey(mycat) = ifind
             else
410            if (keychain(jj).eq.0) then
                 keychain(jj) = ifind
                 keychain(ifind) = 0
               else
                 if(keychain(jj).ne.ifind) then
                   jj = keychain(jj)
                   goto 410
                 endif
               endif
             endif
           endif
         endif
         enddo
         if (.not.append_) then
           close(dirdev)
           nrecd=0
         endif
         dictfl='no '
500      continue
         if (append_) then
           nrecd=nrecds
           recend_=recends
           recbeg_=recbegs
         endif
         if(dict_) then
           dicname_=xdicnam
           dicver_ =xdicver
         else
           tcheck = otchk
           vcheck = ovchk
         endif
         if(tcheck.eq.'yes') vcheck='yes'
!dbg     WRITE(6,'(i5,3x,a,2x,a)') (i,dicnam(i),dictyp(i),i=1,ndict)
         return
         end
!
!
!
!
!
! >>>>>> Create a new dictionary entry, or find a matching existing one
!
         function tbxxnewd(xname,ick)
         logical   tbxxnewd
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character xname*(*)
         character xxxtemp*(NUMCHAR)
         integer   jck, ick, ilen
         integer   lastnb
         tbxxnewd = .true.
         ilen = lastnb(xname)
         jck = ndict
         call tbxxnlc(xxxtemp,xname(1:ilen))
         call hash_store(xxxtemp,                                       &
     &     dicnam,dicchain,                                             &
     &     NUMDICT,ndict,dichash,NUMHASH,ick)
         if(ick.eq.0) call tbxxerr(' CIFdic names > NUMDICT')
         if(ick .eq. jck+1) then
           dictag(ick) = xname(1:ilen)
           dictyp(ick) = ' '
           dicxtyp(ick) = ' '
           catkey(ick) = .false.
           dpindex(ick) = ick
           deindex(ick) = 0
           alias(ick) = 0
           aroot(ick) = ick
           keychain(ick) = 0
           dcindex(ick) = 0
           xmindex(ick) = 0
           dmcode(ick) = 0
         else
           tbxxnewd = .false.
         endif
         return
         end
!
!
!
!
!
! >>>>>> Find matching existing dictionary entry if any
!
         function tbxxoldd(xname,ick)
         logical   tbxxoldd
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character xname*(*)
         character xxxtemp*(NUMCHAR)
         integer   ick, ilen
         integer   lastnb
         tbxxoldd = .true.
         ilen = lastnb(xname)
         call tbxxnlc(xxxtemp,xname(1:ilen))
         call hash_find(xxxtemp,                                        &
     &     dicnam,dicchain,                                             &
     &     NUMDICT,ndict,dichash,NUMHASH,ick)
         if(ick.eq.0) tbxxoldd = .false.
         return
         end
!
!
!
!
!
! >>>>>> Find position of last non_blank in a string
!        but never less than 1
!
         function lastnb(str)
!
         integer    lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character*(*) str
         integer lenn,ihi,itestl
         lenn = len(str)
!
         ihi = lenn
         if(ihi.eq.0) then
           ihi = 1
           go to 200
         endif
         itestl = ihi/4
         if (itestl.lt.4) go to 200
!
100      if (ihi.gt.itestl) then
         if (str(ihi-itestl+1:ihi-itestl+1).eq.' ') then
           if (str(ihi-itestl+1:ihi).eq.' ') then
             ihi = ihi-itestl
             go to 100
           endif
         endif
         endif
         itestl = itestl/2
         if (itestl.gt.3) go to 100
!
200      if (ihi.gt.1 .and. str(ihi:ihi).eq.' ') then
           ihi = ihi-1
           go to 200
         endif
         if (ihi.eq.0) ihi = 1
         lastnb = ihi
         return
         end
!
!
!
!
!
! >>>>>> Convert a character to a radix XXRADIX digit
!
!        given a character c, return a decimal value
!
         function tbxxc2dig(c)
         integer   tbxxc2dig
         character*(*) c
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
!
         tbxxc2dig = ichar(c)-ichar(' ')
!
!        The code above may not be portable, especially to non-ascii
!        computer systems.  In that case, comment out the line above
!        and uncomment the following lines.  Be sure to make the
!        matching change in tbxxd2chr.  Be certain to have at least
!        XXRADIX characters in the search string.
!
!         tbxxc2dig = index(
!     *   '+-01234567890'//
!     *   'abcdefghijlmnopqrstuvwxyz'//
!     *   'ABCDEFGHIJKLMNOPQRSTUVWXYZ',c)-1
         return
         end
!
!
!
!
!
! >>>>>> Convert a radix XXRADIX digit to a character
!
!        given an integer value, return a character
!
         function tbxxd2chr(d)
         character*1 tbxxd2chr
         integer   d
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
!
         tbxxd2chr = char(d+ichar(' '))
!
!        The code above may not be portable, especially to non-ascii
!        computer systems.  In that case, comment out the line above
!        and uncomment the following lines.  Be sure to make the
!        matching change in tbxxc2dig.  Be certain to have at least
!        XXRADIX characters in the search string.
!
!         character*(XXRADIX) digits
!         digits =
!     *   '+-01234567890'//
!     *   'abcdefghijlmnopqrstuvwxyz'//
!     *   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
!         tbxxd2chr = digits(d+1:d+1)
         return
         end
!
!
!
!
!
! >>>>>> Convert a string to Run Length Encoded version
!
         subroutine tbxxrle(astr,bstr,mlen)
!
!        astr is the raw input string
!        bstr is the run-length-encoded string
!          beginning with the compressed length in
!            in base-XXRADIX in the first four characters
!          followed by either individual characters or run
!          flagged by XXFLAG
!        XXFLAG//tbxxd2chr(n)//c represents n copies of c
!
         character*(*) astr, bstr
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character*1 c
         character*1 tbxxd2chr
         integer tbxxc2dig
         integer klen, krep, ialen, iblen, mode, ii
         integer mlen
!
         ialen = len(astr)
         iblen = len(bstr)
         mode = 0
         klen = 4
         bstr(1:4) = tbxxd2chr(0)//tbxxd2chr(0)                         &
     &     //tbxxd2chr(0)//tbxxd2chr(0)
         do ii = 1,ialen
           c = astr(ii:ii)
           if (mode .eq. -2) then
             krep = tbxxc2dig(bstr(klen-1:klen-1))
             if (c.eq.bstr(klen:klen).and.krep.lt.XXRADIX-1) then
               bstr(klen-1:klen-1) = tbxxd2chr(krep+1)
             else
               mode = 0
               if (c.eq.bstr(klen:klen)) mode=-1
             endif
           endif
           if (klen.ge.iblen) go to 100
           if (mode .ge.-1 .and. mode .le.2) then
             klen = klen+1
             bstr(klen:klen) = c
             if (klen .gt. 5) then
               if (c.eq.bstr(klen-1:klen-1)) mode=mode+1
               if (c.ne.bstr(klen-1:klen-1)) mode=0
             endif
             if (c.eq.XXFLAG .and. klen.lt.iblen-1) then
               bstr(klen+1:klen+2) = tbxxd2chr(1)//c
               mode = -2
               klen = klen+2
             endif
           endif
           if (mode.eq.2) then
             bstr(klen-2:klen-1) = XXFLAG//tbxxd2chr(3)
             mode = -2
           endif
         enddo
 100     mlen = klen
         do ii = 4,1,-1
           bstr(ii:ii) = tbxxd2chr(mod(klen,XXRADIX))
           klen = klen/XXRADIX
         enddo
         return
         end
!
!
!
!
!
! >>>>>> Decode a string from  Run Length Encoded version
!
         function tbxxrld(astr,bstr,fill)
!
!        astr is the raw output string
!        bstr is the run-length-encoded string
!          beginning with the compressed length in
!            in base-XXRADIX in the first four characters
!          followed by either individual characters or run
!          flagged by char(0)
!        char(0)//char(n)//c represents n copies of c
!        fill is a logical variable, .true. to fill astr with blanks
!        the return value is the number of valid characters in astr
!        never less than 1
!
!
         character*(*) astr, bstr
         logical fill
         integer tbxxrld
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character*1 c
         integer tbxxc2dig
         integer klen, krep, ialen, mode, ipos
         integer ii, jj
!
         tbxxrld = 1
         krep = 0
         ialen = len(astr)
         if (fill) then
           astr = ' '
         else
           astr(1:1) = ' '
         endif
         mode = 0
         klen = 0
         do ii = 1,4
           klen = klen*XXRADIX+tbxxc2dig(bstr(ii:ii))
         enddo
         mode = 0
         ipos = 0
         do ii = 5,klen
           c = bstr(ii:ii)
           if(mode.eq.0) then
             if(c.ne.XXFLAG) then
               if (ipos.ge.ialen) then
                 tbxxrld = ialen
                 return
               endif
               ipos = ipos+1
               astr(ipos:ipos) = c
             else
               mode = 1
             endif
           else
             if (mode.eq.1) then
               krep = tbxxc2dig(c)
               mode = -1
             else
               do jj = 1,krep
                 if (ipos.ge.ialen) return
                 ipos=ipos+1
                 astr(ipos:ipos) = c
               enddo
               mode = 0
             endif
           endif
         enddo
         if(ipos .lt. ialen) astr(ipos+1:ipos+1) = ' '
         tbxxrld = max(ipos,1)
         return
         end
!
!
!
!
!
! >>>>>> Extract the item.category_id from a save frame name
!
         subroutine tbxxcat(sfname,bcname,lbcname)
!
         character*(*) sfname,bcname
         integer lbcname,ii,ic,lastnb,lenn
!
!        Note that this logic works only for item.category_id
!        not for category.id
!
         lenn = lastnb(sfname)
         bcname = ' '
         lbcname = 1
         if (lenn.eq.0.or.sfname(1:1).ne.'_') return
         do ii = 1,lenn-2
         ic = 1+lenn-ii
         if (sfname(ic:ic).eq.'.') then
           bcname = sfname(2:ic-1)
           lbcname = ic-2
           return
         endif
         enddo
         return
         end
!
!
!
!
!
! >>>>>> Fetch line from direct access file
!
         subroutine tbxxflin(linno,lip,lipag,lipof,kip,ip,mip,mis)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         integer    linno,lip,kip,ip,mip,mis,i,mipno,miprno, kzero
         integer    lipag,lipof,kmode
!
!        linno -- the line number to locate
!        lip   -- the location of the line
!                   (page*(NUMCPP/NUMCIP)+offset)
!        lipag -- the page number (1...)
!        lipof -- the offset (1...)
!        kip   -- subindex number
!        ip    -- subindex offset
!        mip   -- master index number
!        mis   -- master index offset

         kip = (linno-1)/NUMSIP + 1
         ip = mod(linno-1,NUMSIP) + 1
         mip = (kip-1)/NUMMIP + 1
         mis = mod(kip-1,NUMMIP) + 1
!
!        test subindex page number against number in memory
!
         if (kip.ne.iabs(ipim)) then
!
!          save the current subindex page if it has been written
!
           if (ipim.lt.0) then
             do i = 1,NUMSIP
               write(scrbuf(NUMCIP*(i-1)+1:NUMCIP*i),'(i8)')            &
     &           ippoint(i)
             enddo
             write(dirdev,'(a)',rec=iabs(iprim)) scrbuf
             ipim = -ipim
           endif
!
!          find the appropriate master index page and slot
!
           if (mip.ne.iabs(mipim)) then
!
!            save the current master index page if it has been written
!
             if (mipim.lt.0) then
               write(scrbuf(1:NUMCIP),'(i8)')mipcp
               do i = 1,NUMMIP
                 write(scrbuf(NUMCIP*i+1:NUMCIP*(i+1)),'(i8)')          &
     &             mippoint(i)
               enddo
               write(dirdev,'(a)',rec=iabs(miprim))scrbuf
               mipim = -mipim
             endif
!
!            search the master index pages for a match
!
             mipno = 0
             miprno = 1
             kzero = 0
             kmode = 1
 10          read(dirdev,'(a)',rec=miprno) scrbuf
             mipno = mipno+1
             read(scrbuf(1:NUMCIP),'(i8)') mipcp
             if (mipno.ne.mip) then
               if (mipcp.eq.0) then
                 if (nfword.gt.1) then
                   nfblock = nfblock+1
                   nfword = 1
                 endif
                 mipcp = nfblock
                 nfblock = nfblock+1
                 write(scrbuf(1:NUMCIP),'(i8)') mipcp
                 write(dirdev,'(a)',rec=miprno) scrbuf
                 scrbuf = ' '
                 write(scrbuf(1:NUMCIP),'(i8)') kzero
                 write(dirdev,'(a)',rec=mipcp) scrbuf
                 kmode = -1
               endif
               miprno = mipcp
               go to 10
             endif
!
!            Have the master index in scrbuf, copy to mippoint
!
             do i = 1,NUMMIP
               if (scrbuf(NUMCIP*i+1:NUMCIP*(i+1)).eq.' ') then
                 mippoint(i) = 0
               else
                 read(scrbuf(NUMCIP*i+1:NUMCIP*(i+1)),'(i8)')           &
     &             mippoint(i)
               endif
             enddo
             mipim =kmode* mip
             miprim = miprno
           endif
!
!          See if the subindex page exists
!
           if (mippoint(mis).eq.0) then
             do i = 1,NUMSIP
               ippoint(i) = 0
             enddo
             if (nfword.gt.1) then
               nfblock=nfblock+1
               nfword = 1
             endif
             mippoint(mis) = nfblock
             mipim = -iabs(mipim)
             ipim = -kip
             iprim = -nfblock
             scrbuf = ' '
             write(dirdev,'(a)', rec=nfblock) scrbuf
             nfblock = nfblock+1
           else
             read(dirdev,'(a)', rec=mippoint(mis)) scrbuf
             do i = 1,NUMSIP
               if (scrbuf(NUMCIP*(i-1)+1:NUMCIP*i).eq.' ') then
                 ippoint(i) = 0
               else
               read(scrbuf(NUMCIP*(i-1)+1:NUMCIP*i),'(i8)')             &
     &           ippoint(i)
               endif
             enddo
             ipim = kip
             iprim = mippoint(mis)
           endif
         endif
         lip = ippoint(ip)
         lipag = (lip-1)/(NUMCPP/NUMCIP) + 1
         lipof = mod(lip-1,NUMCPP/NUMCIP) + 1
         lipof = (lipof-1)*NUMCIP + 1
         return
         end

!
!
!
!
!
! >>>>>> Store a string in the string table
!
         subroutine tbxxsstb(astrg,sindex)
!
!        store string astrg in the string table, returning the
!        index in sindex
!
         character *(*) astrg
         integer sindex
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character *(MAXBUF) temp
         integer mlen, ii, ibstb, icstb, ikstb, rlen
         integer iestb

         call tbxxrle(astrg,temp,mlen)
         icstb = mod(nstable,NUMCSTB)+1
         ibstb = (nstable+NUMCSTB)/NUMCSTB
         iestb = min(NUMCSTB,icstb+mlen-1)
         ikstb = iestb-icstb+1
         if (mlen+nstable .le. NUMCSTB*NUMSTB) then
           stable(ibstb)(icstb:iestb)=temp(1:ikstb)
           sindex = nstable+1
           nstable = nstable+mlen
           rlen = mlen - ikstb
           if (rlen .gt. 0) then
             do ii = ikstb+1,mlen,NUMCSTB
               ibstb = ibstb+1
               iestb = min(NUMCSTB,rlen)
               stable(ibstb)(1:iestb) = temp(ii:ii+iestb-1)
               rlen = rlen - iestb
             enddo
           endif
         else
           sindex = 0
           call tbxxwarn(                                               &
     &      ' More than NUMCSTB*NUMSTB stable characters needed')
         endif
         return
         end

!
!
!
!
!
! >>>>>> Fetch a string from the string table
!
         function tbxxfstb(astrg,sindex,fill)
!
!        fetch string astrg from the string table, starting at the
!        index in sindex, and returning the valid length.
!
!        fill is a logical variable, .true. to fill astr with blanks
!        the return value is the number of valid characters in astr
!        never less than 1, unless there is no valid string

         integer tbxxfstb
         character *(*)astrg
         integer sindex
         logical fill
         integer tbxxc2dig, tbxxrld
         integer rlen
         integer icstb, ibstb, iestb, ikstb, klen, ii

!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character *(MAXBUF) temp

         tbxxfstb = 0

         if (sindex.le.0.or.nstable+3.gt.NUMCSTB*NUMSTB) return

         icstb = mod(sindex-1,NUMCSTB)+1
         ibstb = (sindex-1+NUMCSTB)/NUMCSTB
         iestb = min(NUMCSTB,icstb+3)
         ikstb = iestb-icstb+1
         temp(1:ikstb)=stable(ibstb)(icstb:iestb)

         rlen = 4-ikstb
         if (rlen .gt. 0) then
         temp(ikstb+1:4)=stable(ibstb+1)(1:rlen)
         endif

         klen = 0
         do ii = 1,4
           klen = klen*XXRADIX+tbxxc2dig(temp(ii:ii))
         enddo

         if (klen.gt.MAXBUF.or.klen.le.0) return
         if (sindex+klen-1.gt.NUMCSTB*NUMSTB) return

         if (klen.gt.4) then
           icstb = mod(sindex+3,NUMCSTB)+1
           ibstb = (sindex+3+NUMCSTB)/NUMCSTB
           iestb = min(NUMCSTB,icstb+klen-5)
           ikstb = iestb-icstb+1
           temp(5:ikstb+4) = stable(ibstb)(icstb:iestb)
           rlen = klen - ikstb - 4
           if (rlen .gt. 0) then
             do ii = ikstb+1,ikstb+rlen,NUMCSTB
               ibstb = ibstb+1
               iestb = min(NUMCSTB,rlen)
               temp(ii:ii+iestb-1) = stable(ibstb)(1:iestb)
               rlen = rlen - iestb
             enddo
           endif
         endif

         tbxxfstb = tbxxrld(astrg,temp(1:klen),fill)
         return
         end


!
!
!
!
!
! >>>>>> Open a CIF and copy its contents into a direct access file.
!
         function ocif_(fname)
!
         logical   ocif_
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical   test
         character fname*(*)
         integer   lfname
         integer   case,i,kp,lp,mp
         integer   klen, mlen, lip, lppag, lipof, kip, ip, mip, mis
!
         save_=.false.
         glob_=.false.
         depth_=0
         jchar=MAXBUF
         lastch=0
         if(line_.gt.MAXBUF) call tbxxerr(' Input line_ value > MAXBUF')
         if(nrecd.ne.0 .and. (.not.append_)) then
           close(dirdev)
           nrecd=0
           lrecd=0
         endif
!
!        clear the memory resident page buffer
!
         do i = 1,NUMPAGE
         mppoint(i)=0
         enddo
!
         case=ichar('a')-ichar('A')
         tab=char(05)
         if(case.lt.0) goto 100
         tab=char(09)
         bloc_=' '
!
!....... Make sure the CIF is available to open
!
100      file_(1:longf_)=' '
         lfname = len(fname)
         file_(1:lfname) = fname
         do 120 i=1,lfname
         if(file_(i:i).eq.' ' .or. file_(i:i).eq.char(0) ) goto 140
120      continue
140      longf_=i-1
         if (longf_.gt.0) then
           inquire(file=file_(1:longf_),exist=test)
           ocif_=test
           if(.not.ocif_)      goto 200
         else
           file_(1:1) = ' '
           longf_ = 1
           ocif_ = .true.
         endif
!
!....... Open up the CIF and a direct access formatted file as scratch
!
         if (file_(1:1).ne.' ')                                         &
     &   open(unit=cifdev,file=file_(1:longf_),status='OLD',            &
     &                    access='SEQUENTIAL',                          &
     &                    form='FORMATTED')
         if(nrecd.eq.0)  then
           open(unit=dirdev,file='test',status='UNKNOWN',access='DIRECT',           &
     &                    form='FORMATTED',recl=NUMCPP)
           mipim = -1
           miprim = 1
           mipcp = 0
           ipim = -1
           iprim = 2
           do i = 1,NUMPAGE
             mppoint(i) = 0
           enddo
           do i = 1,NUMMIP
             mippoint(i) = 0
           enddo
           mippoint(1)=2
           do i = 1,NUMSIP
             ippoint(i) = 0
           enddo
           nfblock = 3
           nfword = 1
         endif
         if (mppoint(1).lt.0) then
            write(dirdev,'(a)',rec=-mppoint(1)) pagebuf(1)
            mppoint(1) = 0
         endif
         if(append_ .and. nrecd.ne.0) then
           kp = 1
           lp = nfblock
           nfblock = nfblock+1
           mppoint(kp) = lp
           mp = 1
         else
           do kp = 1,NUMPAGE
             mppoint(kp)=0
           enddo
           kp = 1
           lp = 3
           nfblock = 4
           mp = 1
         endif
!
!....... Copy the CIF to the direct access file
!
160      read(cifdev,'(a)',end=180) buffer
         nrecd=nrecd+1
         irecd=nrecd
         klen = lastnb(buffer(1:MAXBUF))
         if (klen.gt.line_)                                             &
     &     call tbxxwarn(' Input line length exceeds line_')
         call tbxxrle(buffer(1:klen),scrbuf,mlen)
         if (mp+mlen-1 .gt. NUMCPP) then
           if (mp.lt.NUMCPP) pagebuf(kp)(mp:NUMCPP) = ' '
!          write(dirdev,'(a)',rec=lp) pagebuf(kp)
           mppoint(kp)=-lp
           if (nfword.gt.1) then
             nfblock = nfblock+1
             nfword = 1
           endif
           lp = nfblock
           nfblock=nfblock+1
           kp = kp+1
           if(kp.gt.NUMPAGE) kp=1
           if (mppoint(kp).lt.0) then
             write(dirdev,'(a)',rec=-mppoint(kp)) pagebuf(kp)
           endif
           mppoint(kp)=0
           mp=1
         endif
         pagebuf(kp)(mp:mp+mlen-1)=scrbuf(1:mlen)
         mppoint(kp) = -lp
         mlen = ((mlen+NUMCIP-1)/NUMCIP)
         mlen = mlen*NUMCIP
         call tbxxflin(nrecd,lip,lppag,lipof,kip,ip,mip,mis)
         ippoint(ip) = (mp-1)/NUMCIP+(lp-1)*(NUMCPP/NUMCIP)+1
         ipim = -iabs(ipim)
         mp = mp+mlen
         goto 160
!
180      if (mp.lt.NUMCPP) pagebuf(kp)(mp:NUMCPP) = ' '
         if (mp.gt.1) then
!          write(dirdev,'(a)',rec=lp) pagebuf(kp)
           mppoint(kp)=-lp
         endif
         lrecd=max(0,recbeg_-1)
         jrecd=max(0,recbeg_-1)
         jrect=-1
         irecd=max(0,recbeg_-1)
         recn_=irecd
         recend_=nrecd
         if (file_(1:1).ne.' ') close(cifdev)
200      return
         end
!
!
!
!
!
! >>>>>> Close off direct access file of the current CIF
!         and reset all data name tables and pointers
!
         subroutine purge_
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
!
         integer i
         if(nrecd.ne.0) close(dirdev)
         do i = 1,NUMPAGE
           mppoint(i)=0
         enddo
         do i = 1,MAXBOOK
           ibkmrk(1,i)=-1
           ibkmrk(2,i)=-1
           ibkmrk(3,i)=-1
           ibkmrk(4,i)=-1
           ibkmrk(5,i)=-1
           ibkmrk(6,i)=-1
         enddo
         recn_=0
         save_=.false.
         glob_=.false.
         jchar=MAXBUF
         depth_=0
         lastch=0
         nrecd=0
         lrecd=0
         irecd=0
         nname=0
         nhash=0
         iname=0
         loopct=0
         loopnl=0
         loop_=.false.
         text_=.false.
         textfl='no '
         append_=.false.
         recbeg_=0
         recend_=0
         nivt = 0
         nstable = 0
         return
         end
!
!
!
!
!
! >>>>>> Store the data names and pointers for the requested data block
!
         function data_(name)
!
         logical   data_
         logical   wasave
         logical   tbxxoldd
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character name*(*),temp*(NUMCHAR),ltype*4
         character ctemp*(NUMCHAR)
         character xdname*(NUMCHAR)
         character ydname*(NUMCHAR)
         character isbuf*(MAXBUF),lsbuf*(MAXBUF)
         logical   ixcat(NUMDICT)
         integer   ndata,idata,nitem,npakt,i,ii,j,k,kchar,krecd
         integer   jj,icc,idd
         integer   fcatnum,lctemp,isrecd,isjchr,islast
         integer   lsrecd,lsjchr,lslast
         integer   pnname,itpos,ipp,ipj
         integer   ltemp
!DBG     if(dictfl.eq.'no ')
!DBG *     print *,' ***>>>> Entering data_ ',name
!
         jchar=MAXBUF
         depth_=0
         nname=0
         ndata=0
         nhash=0
         nitem=0
         idata=0
         iname=0
         loopct=0
         loopnl=0
         ltype=' '
         posnam_=0
         posval_=0
         posdec_=0
         posend_=0
         kchar = 0
         krecd = 0
         fcatnum = 0
         data_=.false.
         wasave=.false.
         loop_=.false.
         text_=.false.
         textfl='no '
         glob_=.false.
         do ii = 1,MAXBOOK
         ibkmrk(1,ii)=-1
         enddo
         irecd=lrecd
         lrecd=min(nrecd,recend_)
         if(name(1:1).ne.' ') irecd=max(0,recbeg_-1)
         call hash_init(dname,dchain,NUMBLOCK,nname,dhash,              &
     &     NUMHASH)
         call hash_init(cname,cchain,NUMBLOCK,ncname,chash,             &
     &     NUMHASH)
         isrecd=irecd
         isjchr=jchar
         islast=lastch
         lsrecd=isrecd
         lsjchr=isjchr
         lslast=islast
         isbuf=' '
         if(lastch.gt.0)isbuf(1:lastch)=buffer(1:lastch)
         lsbuf=' '
         if(lastch.gt.0)lsbuf(1:lastch)=isbuf(1:lastch)
         call tbxxnlc(xdname,name)
!
!....... Find the requested data block in the file
!
100      lsjchr=isjchr
         call getstr
         isjchr=jchar
         if(irecd.ne.isrecd) then
           lsrecd=isrecd
           lslast=islast
           lsbuf=' '
           if(islast.gt.0)lsbuf(1:islast)=isbuf(1:islast)
           isrecd=irecd
           islast=lastch
           isbuf=' '
           if(lastch.gt.0)isbuf(1:lastch)=buffer(1:lastch)
         endif
         if(type_.eq.'fini')           goto 500
         if(text_.or.depth_.gt.0)      goto 110
         goto 120
110      call getstr
         if (type_.eq.'fini')                                           &
     &      call tbxxerr(' Unexpected termination of file')
         if (text_.or.depth_.gt.0)     goto 100
         goto 100
120      continue
         if(type_.eq.'save') then
           if(long_.lt.6) then
             if(.not.save_)                                             &
     &         call tbxxerr(                                            &
     &           ' Save frame terminator found out of context ')
             wasave=.true.
             save_=.false.
             goto 100
           else
             if(save_)                                                  &
     &         call tbxxerr(' Prior save frame not terminated ')
             save_=.true.
             if(name.eq.' ')          goto 150
             call tbxxnlc(ydname,strg_(6:long_))
             if(ydname.ne.xdname) goto 100
             goto 150
           endif
         endif
         if(type_.eq.'glob') then
           if(name.ne.' ')            goto 100
           glob_=.true.
           goto 150
         endif
         if(type_.eq.'name'.or.type_.eq.'loop') then
           if(name.ne.' ')            goto 100
           if(.not.wasave)                                              &
     &       call tbxxwarn(' Data block header missing ')
           isrecd=lsrecd
           islast=lslast
           isjchr=lsjchr
           isbuf=' '
           if(islast.gt.0)isbuf(1:islast)=lsbuf(1:islast)
           data_=.true.
           bloc_=' '
           itpos=jchar-long_
           if(tabx_) then
           itpos=0
           do ipp=1,jchar-long_
             itpos=itpos+1
             if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
           enddo
           endif
           posnam_=itpos
           goto 204
         endif
         if(type_.ne.'data')          goto 100
         if(name.eq.' ')              goto 150
         call tbxxnlc(ydname,strg_(6:long_))
         if(ydname.ne.xdname)   goto 100
150      data_=.true.
         bloc_=strg_(6:long_)
!
!DBG     if(dictfl.eq.'no ')
!DBG *     print *, 'bloc_: '//bloc_
         itpos=jchar-long_
         if(tabx_) then
         itpos=0
         do ipp=1,jchar-long_
           itpos=itpos+1
           if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
         enddo
         endif
         posnam_=itpos
!
!....... Get the next token and identify
!        ltype is the previous type
!
200      call getstr
!DBG     WRITE(6,*) ltype,type_,loop_,nitem,ndata,idata,iname,nname
!
         if(ltype.ne.'name')                goto 201
         if(type_.eq.'numb')                goto 203
         if(type_.eq.'char')                goto 203
         if(type_.eq.'text')                goto 203
         if(type_.eq.'null')                goto 203
         if(type_.eq.'tupl'                                             &
     &     .or.type_.eq.'tabl'                                          &
     &     .or.type_.eq.'arra')             goto 203
         if(type_.eq.'name'.and.loop_)      goto 204
!DBG     WRITE(6,*) ltype,type_,loop_,nitem,ndata,idata,iname,nname
         call tbxxerr(                                                  &
     &     ' Illegal tag/value construction: tag followed by '          &
     &     //type_)    
!
!        The prior type was not a name (not a tag)
201      if(ltype.ne.'valu')                goto 204
!
!        The prior type was a data value
!
         if(type_.eq.'numb')                goto 202
         if(type_.eq.'char')                goto 202
         if(type_.eq.'text')                goto 202
         if(type_.eq.'null')                goto 202
         if(type_.eq.'tupl'                                             &
     &     .or.type_.eq.'tabl'                                          &
     &     .or.type_.eq.'arra')             goto 202
         goto 204
!
!        If we have a vaue followed by a value, we need to be
!        in a loop (item > 0)
!
202      if(nitem.gt.0)                     goto 205
         call tbxxerr(                                                  &
     &     ' Illegal tag/value construction: value followed by '        &
     &     //type_)
!
!        The prior item was a tag and this is a value
!
203      ltype='valu'
!DBG     if(dictfl.eq.'no ')
!DBG *     print *, ' ***>>>>> data_ value ',strg_(1:long_)
         goto 205
!
!        Cases that get us here
!          The prior item was a tag and this is a tag in a loop
!          The prior item was neither a tag nor a value 
204      ltype=type_
!
!        We are in a loop and have a value after a value
!        or a name after a value or come from above cases
!
205      if(type_.eq.'name')           goto 206
         if(type_.eq.'loop')           goto 210
         if(type_.eq.'data')           goto 210
         if(type_.eq.'save')           goto 210
         if(type_.eq.'glob')           goto 210
         if(type_.ne.'fini')           goto 220
206      if(loop_)                     goto 270
210      if(nitem.eq.0)                goto 215
!
!....... End of loop detected; save pointers
!        loopni(loopct) -- number of items in a row
!        loopnp(loopct) -- number of rows
!
         npakt=idata/nitem
         if(npakt*nitem.ne.idata) call tbxxerr(' Item miscount in loop')
         loopni(loopct)=nitem
         loopnp(loopct)=npakt
         nitem=0
         idata=0
215      if(type_.eq.'name')           goto 270
         if(type_.eq.'data')           goto 300
         if(type_.eq.'save')           goto 300
         if(type_.eq.'glob')           goto 300
         if(type_.eq.'fini')           goto 300
!
!....... Loop_ line detected; incr loop block counter
!        record the character position in loopos(loopct)
!        record the line number in        loorec(loopct)
!        record the detabbed char pos in  loopox(loopct)
!
         loop_=.true.
!DBG     print *,' in data_ loop_ set, type_', type_
         loopct=loopct+1
         if(loopct.gt.NUMLOOP) call tbxxerr(                            &
     &     ' Number of loop_s > NUMLOOP')
         loorec(loopct)=irecd
         loopos(loopct)=jchar-long_
         if(quote_.ne.' ') then
           if (quote_.eq.';') then
             loopos(loopct) = 1
           else
             if (quote_.eq.''''''''.or.quote_.eq.'"""') then
               loopos(loopct)=jchar-long_-3
             else
               loopos(loopct)=jchar-long_-1
             end if
           end if
         end if
         itpos=0
         do ipp=1,loopos(loopct)
           itpos=itpos+1
           if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
         enddo
         loopox(loopct)=itpos
         goto 200
!
!....... This is the data item; store char position and length
!
220      if(loop_ .and. nitem.eq.0)                                     &
     &   call tbxxerr(' Illegal tag/value construction')
         loop_=.false.
!
         i=nname
         if(nitem.gt.0) i=i-nitem+mod(idata,nitem)+1
         if(i.lt.1) call tbxxerr(' Illegal tag/value construction')
         if(dtype(i).ne.'test')       goto 223
         if(dictfl.eq.'yes')          goto 223
         if(tcheck.eq.'no ')          goto 223
!>>>>    if(long_.eq.1.and.strg_(1:1).eq.'?') goto 223
!>>>>    if(long_.eq.1.and.strg_(1:1).eq.'.') goto 223
         if(type_.eq.'null')          goto 223
         if(type_.eq.'numb')          goto 223
         call tbxxwarn( ' Numb type violated  '//dname(i))
223      if(nitem.le.0)               goto 224
         idata=idata+1
         if(dtype(i).eq.'null') dtype(i)=type_
         if(dtype(i).eq.'numb' .and.                                    &
     &     (type_.eq.'char'.or.type_.eq.'text')) dtype(i)='char'
224      if(nname.eq.ndata)           goto 230
         ndata=ndata+1
         if(iloop(ndata).gt.1)        goto 225
         krecd=irecd
         kchar=jchar-long_-1
         if(quote_.ne.' ') then
           kchar=kchar-1
           if (quote_(2:3).ne.'  ') kchar=kchar-2
         end if
225      continue
         if(dtype(ndata).eq.'    ') dtype(ndata)=type_
         drecd(ndata)=krecd
         dchar(ndata)=kchar
         if (depth_.gt.0) then
!DBG     print *,' Setting bracket start at ',
!DBG *     'char: ', posbrkstk(1)-1, 'rec: ',srecd
         dchar(ndata) = posbrkstk(1)-1
         drecd(ndata) = srecd

         end if
         if(nloop(ndata).gt.0)        goto 230
         nloop(ndata)=0
         iloop(ndata)=long_
         if (depth_.gt.0) iloop(ndata) = 1
!
!....... Skip text lines if present
!
230      if(type_.ne.'text')           goto 250
!DBG     print *,' text field detected at 230 '
         if(nloop(ndata).eq.0.and.depth_.eq.0) dchar(ndata)=0
         if(nloop(ndata).eq.0.and.depth_.eq.0) iloop(ndata)=long_
240      call getstr
         if(type_.eq.'fini') call tbxxerr(' Unexpected end of data')
         if (type_.ne.'text'.or..not.text_) then
           if (depth_.eq.0)            goto 200
           goto 260
         endif
         goto 240
!
!....... Skip bracketed construct if present
!
250      if(depth_.eq.0)           goto 200
         
260      call getstr
         if(depth_.eq.0) goto 200
         if(type_.eq.'fini') call tbxxerr(' Unexpected end of data')
         if(type_.eq.'text') goto 240
         goto 260
!
!....... This is a data name; store name and loop parameters
!
270      call tbxxclc(temp,ltemp,strg_(1:long_),long_)
         k=0
         if(dictfl.ne.'yes' .and. ndict.gt.0) then
           tbxxrslt = tbxxoldd(temp(1:ltemp),k)
           if(k.ne.0) then
             if(alias_ .and. aroot(k).ne.0) then
               temp=dicnam(aroot(k))
               ltemp = lastnb(temp)
             endif
           endif
         endif
         pnname=nname
         call hash_store(temp(1:ltemp),                                 &
     &   dname,dchain,NUMBLOCK,nname,dhash,                             &
     &     NUMHASH,j)
!DBG     if(dictfl.eq.'no ')
!DBG *     print *,' ***>>>>> data_ name: ',temp(1:ltemp)
         if(j.eq.pnname+1) then
           dtag(j)=strg_(1:long_)
           if(k.ne.0) dtag(j)=dictag(k)
           trecd(j)=irecd
           tchar(j)=jchar-long_
           if(quote_.ne.' '.and.quote_.ne.';')                          &
     &       tchar(j)=jchar-long_-1
           itpos=0
           do ipp=1,tchar(j)
             itpos=itpos+1
             if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
           enddo
           xchar(j)=itpos
         endif
         if(j.eq.0)                                                     &
     &     call tbxxerr(' Number of data names > NUMBLOCK')
         if(k.ne.0) then
           ltemp = lastnb(dicnam(k))
           temp(1:ltemp) = dicnam(k)(1:ltemp)
         endif
         if(j.ne.pnname+1) then
           call tbxxwarn(' Duplicate data item '//                      &
     &     temp(1:ltemp))
           goto 200
         endif
         dtype(nname)=' '
         dxtyp(nname)=' '
         cindex(nname)=0
         ddict(nname)=0
         ctemp(1:6)='(none)'
         lctemp=6
!
         if(dictfl.eq.'yes' .or. vcheck.eq.'no ') goto 290
         j=k
         if(j.ne.0) then
           ddict(nname)=j
           cindex(nname)=dcindex(j)
           dxtyp(nname)=dicxtyp(j)
           dtype(nname)=dictyp(j)
           if(vcheck.eq.'no ')          goto 280
           if(dictyp(j).eq.'numb') then
             dtype(nname)='test'
           endif
           if(cindex(nname).ne.0) then
             lctemp=lastnb(dcname(cindex(nname)))
             ctemp(1:lctemp)=dcname(cindex(nname))(1:lctemp)
             goto 290
           endif
           goto  280
         endif
         call tbxxwarn(' Data name '//                                  &
     &               temp(1:ltemp)                                      &
     &               //' not in dictionary!')
280      call tbxxcat(temp(1:ltemp),ctemp,lctemp)
         if (ctemp(1:lctemp).eq.' '.or.                                 &
     &     ('_'//ctemp(1:lctemp).eq.temp(1:ltemp))) then
           ctemp = '(none)'
           lctemp= 6
           if (ndcname.ne.0.and.vcheck.eq.'yes')                        &
     &       call tbxxwarn(' No category defined for '                  &
     &       //temp(1:ltemp))
         else
           call hash_find(ctemp(1:lctemp),                              &
     &       dcname,dcchain,NUMDICT,ndcname,dchash,NUMHASH,j)
           if(j.ne.0) then
             cindex(nname) = j
           else
             ipj=ncname
             call hash_store(ctemp(1:lctemp),                           &
     &         cname,cchain,NUMBLOCK,ncname,chash,NUMHASH,j)
             if (j.eq.0)                                                &
     &         call tbxxerr(' Number of categories > NUMBLOCK ')
             cindex(nname) = -j
             if (ndcname.gt.0.and.j.eq.ipj+1.and.vcheck.eq.'yes'        &
     &         .and.catchk.eq.'yes')                                    &
     &         call tbxxwarn(' Category '//                             &
     &         ctemp(1:lctemp)//' first implicitly defined in cif ')
           endif
         endif
!
290      lloop(nname)=0
         nloop(nname)=0
         iloop(nname)=0
         if (nitem.eq.0) fcatnum=cindex(nname)
         if(.not.loop_)               goto 200
         nitem=nitem+1
         if(nitem.gt.NUMITEM)                                           &
     &     call tbxxerr(' Items per loop packet > NUMITEM')
         nloop(nname)=loopct
         iloop(nname)=nitem
         if (fcatnum.ne.cindex(nname)) then
           temp = '(none)'
           if (fcatnum.gt.0) temp=dcname(fcatnum)
           if (fcatnum.lt.0) temp=cname(-fcatnum)
           ltemp = lastnb(temp)
           if (ctemp(1:lctemp).ne.temp(1:ltemp)                         &
     &     .and.catchk.eq.'yes')                                        &
     &     call tbxxwarn (' Heterogeneous categories in loop '//        &
     &     ctemp(1:lctemp)//' vs '//                                    &
     &     temp(1:ltemp))
           fcatnum=cindex(nname)
         endif
         goto 200
300      continue
!
!....... Are names checked against dictionary?
!
         if(dictfl.eq.'yes')          goto 500
         if(vcheck.eq.'no '.or.ndict.eq.0) goto 500
         do i=1,nname
           if(dtype(i).eq.'test') dtype(i)='numb'
         enddo

!
!        prepare for category and parent checks
!
         if ((catchk.eq.'yes'.or.parchk.eq.'yes')                       &
     &      .and. ndict.gt.0) then
         do i = 1,ndict
           ixcat(i) = .false.
         enddo
!
!        make a pass marking all used tags and their aliases
!
         do i = 1,nname
           icc=cindex(i)
           idd=ddict(i)
           if(icc.ne.0.and.idd.ne.0) then
             icc = aroot(idd)
310          ixcat(icc) = .true.
             icc = alias(icc)
             if (icc.ne.0) goto 310
           endif
         enddo
         endif
!
!        check for category keys
!
!
!
!        now make a pass making certain the keys are
!        used
!
         if(catchk.eq.'yes' .and. ndict.gt.0) then
         do i = 1,nname
           idd=cindex(i)
           if (idd.gt.0) then
             icc=ccatkey(idd)
             if(icc.ne.0) then
             if(aroot(icc).ne.0) icc=aroot(icc)
320          if(icc.ne.0) then
               if(.not.ixcat(icc)) then
                 jj = irecd
                 irecd = drecd(i)
                 if (catkey(icc)) then
				 
				 !KJ 11-2011 for FEFF9 code : removing the warnings below.  They seem irrelevant to my case, and are confusing to the user.
    !               call tbxxwarn(' Category key '//                     &
    ! &               dictag(icc)(1:lastnb(dictag(icc)))//               &
    ! &               ' not given for '//                                &
    ! &               dcname(idd)(1:lastnb(dcname(idd))))
                 else
                   call tbxxwarn(' Mandatory item '//                   &
     &               dictag(icc)(1:lastnb(dictag(icc)))//               &
     &               ' not given for '//                                &
     &               dcname(idd)(1:lastnb(dcname(idd))))
                 endif
                 ixcat(icc) = .true.
                 irecd = jj
               endif
               icc = keychain(icc)
               if(icc.ne.0) go to 320
             endif
             endif
           endif
         enddo
         endif
!
!        check for parents of tags that are used
!
         if(parchk.eq.'yes' .and. ndict.gt.0) then
         do i = 1,nname
           if (ddict(i).ne.0) then
             if (dpindex(ddict(i)).ne.ddict(i)) then
               if (.not.ixcat(dpindex(ddict(i)))) then
                 call tbxxwarn(' Parent '//                             &
     &             dicnam(dpindex(ddict(i)))                            &
     &             (1:lastnb(dicnam(dpindex(ddict(i)))))//              &
     &             ' of '//                                             &
     &             dname(i)(1:lastnb(dname(i))) //                      &
     &             ' not given')
               endif
             endif
           endif
         enddo
         endif

!
!....... End of data block; tidy up loop storage
!
500      lrecd=irecd-1
         if(type_.eq.'save'.and.long_.lt.6) then
           itpos=jchar-long_
           if(tabx_) then
           itpos=0
           do ipp=1,jchar-long_
             itpos=itpos+1
             if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
           enddo
           endif
           posval_=itpos
         endif
         irecd=isrecd
         jchar=isjchr
         lastch=islast
         recn_=irecd
         buffer(1:1)=' '
         if(lastch.gt.0)buffer(1:min(MAXBUF,lastch))=isbuf(1:lastch)
         jrecd=irecd
         loop_=.false.
         loopct=0
         if(ndata.ne.nname) call tbxxerr(' Syntax construction error')
!
!dbg     WRITE(6,'(a)')
!dbg *   ' data name                       type recd char loop leng'
!dbg     WRITE(6,'(a,1x,a,4i5)') (dname(i),dtype(i),drecd(i),dchar(i),
!dbg *              nloop(i),iloop(i),i=1,nname)
!dbg     WRITE(6,'(3i5)') (i,loopni(i),loopnp(i),i=1,loopct)
!
         return
         end
!
!
!
!
!
! >>>>>> Check dictionary for data name validation
!
         function dtype_(name,type)
!
         logical    dtype_, tbxxoldd
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         integer    nln, ii
         character  name*(*),temp*(NUMCHAR),                            &
     &              type*4
!
         character*4 map_type(19),map_to(19),mapped
         data map_type                                                  &
     &   /'floa','int ','yyyy','symo','ucha','ucod','name','idna',      &
     &    'any ','code','line','ulin','atco','fax ','phon','emai',      &
     &    'real','inte','coun'/
         data map_to                                                    &
     &   /'numb','numb','char','char','char','char','char','char',      &
     &    'char','char','char','char','char','char','char','char',      &
     &    'numb','numb','numb'/

!
         type = ' '
         dtype_ = .false.
         nln = min(len(name),len(temp))
         call tbxxnlc(temp(1:nln),name)
         if (ndict.eq.0) go to 200
         tbxxrslt = tbxxoldd(temp(1:nln),xdchk)
         if(xdchk.eq.0) go to 200
         mapped = dictyp(xdchk)(1:4)
         do ii = 1,19
           if (dictyp(xdchk)(1:4).eq.map_type(ii)) mapped = map_to(ii)
         enddo
         if (mapped.ne.'char'.and.mapped.ne.'numb'                      &
     &     .and.mapped.ne.'null'.and.mapped.ne.'text') then
           call tbxxwarn(' Item type '                                  &
     &        //dictyp(xdchk)(1:max(1,lastnb(dictyp(xdchk))))//         &
     &       ' for item '//                                             &
     &       name(1:max(1,lastnb(name)))//' not recognized ')
           mapped = 'char'
         endif
         type = mapped
         dtype_ = .true.
200      continue
         return
         end
!
!
!
!
!
!
! >>>>>> Get the attributes of data item associated with data name
!
         function test_(temp)
!
         logical   test_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  temp*(*),name*(NUMCHAR)
         character*4 otype
         integer lname
         character  otestf*3
!
         otestf=testfl
         otype = type_
         testfl='yes'
         test_ = .false.
         call tbxxclc(name,lname,temp,len(temp))
!DBG     print *,' Entering test_ ',name(1:lname)
         if (depth_.eq.0) go to 100
         if (name(1:1).ne.' '.and.name(1:1).ne.char(0).and.             &
     &     name(1:lname).ne.nametb(1:lnametb))     goto 120
         call getstr
         test_=.true.
         if (type_.eq.'null') test_=.false.
         if (otype.eq.'text' .and. (.not. text_) .and.long_.eq.0) then
           quote_=' '
           textfl = 'no'
           type_ = 'null'
           test_ = .false.
           goto 200
         end if
         posval_ = jchar-long_
         posend_ = jchar-1
         if (long_.gt.0) then
            if (type_.eq.'numb') then
               call ctonum
               if(posdec_.gt.0) posdec_=posval_+posdec_-1
               jchar = posend_
            else 
              if (quote_.eq.' ') then
                 if (long_.eq.1.and.strg_(1:1).eq.'?') type_='null'
                 if (long_.eq.1.and.strg_(1:1).eq.'.') type_='null'
              end if
            end if
         end if
         goto 200

         
100      test_=.true.
         if(otestf.eq.'no ' .or. type_.eq.' ')  goto 120
         if(name(1:lname).eq.nametb(1:lnametb))   goto 200
120      call tbxxgitm(name(1:lname))
200      list_ =loopnl
         if(type_.eq.'null') test_=.false.
         if(type_.ne.'null'.and.type_.ne.'char'.and.                    &
     &     type_.ne.'text'.and.type_.ne.'numb') type_='char'
!DBG     print *,' leaving test_ ', type_, depth_, strg_(1:long_)
         return
         end

!
!
!
!
!
! >>>>>> Set or Reference a bookmark
!
         function bkmrk_(mark)
!
         logical   bkmrk_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
!
         integer   mark,ii,nitem
         character*4 flag
         bkmrk_=.true.
         if(mark.eq.0) then
           do ii=1,MAXBOOK
             if(ibkmrk(1,ii).lt.0)      goto 100
           enddo
           bkmrk_=.false.
           call tbxxwarn(' More than MAXBOOK bookmarks requested')
           return
100        mark=ii
           ibkmrk(1,ii)=iname
           ibkmrk(2,ii)=irecd
           ibkmrk(3,ii)=jchar
           if(iname.gt.0) then
             ibkmrk(2,ii) = trecd(iname)
             ibkmrk(3,ii) = tchar(iname)
           endif
           ibkmrk(4,ii)=0
           if(iname.gt.0) then
             if(nloop(iname).ne.0.and.                                  &
     &         loopnl.eq.nloop(iname).and.loopct.ne.0) then
               nitem=loopni(nloop(iname))
               ibkmrk(2,ii)=looprd(1)
               ibkmrk(3,ii)=max(0,loopch(1)-1)
               ibkmrk(4,ii)=loopct
             endif
           endif
           ibkmrk(5,ii) = depth_
           ibkmrk(6,ii) = index_
         else
           if(ibkmrk(1,mark).lt.0) then
             bkmrk_=.false.
             return
           endif
           iname=ibkmrk(1,mark)
           irecd=ibkmrk(2,mark)
           loopct=ibkmrk(4,mark)
           loop_=.false.
           text_=.false.
           textfl = 'no '
           loopnl=-1
           testfl='no '
           if(iname.gt.0) then
            if(nloop(iname).ne.0.and.loopct.ne.0) then
               nitem=loopni(nloop(iname))
               looprd(nitem+1)=ibkmrk(2,mark)
               loopch(nitem+1)=ibkmrk(3,mark)
               do ii = 1,nitem
                 lloop(ii+iname-iloop(iname))=loopct-1
               enddo
               loopct=loopct-1
               if(lloop(iname).gt.0) then
                 loop_=.true.
                 loopnl=nloop(iname)
               endif
             endif
           endif
           jchar=MAXBUF
           if(irecd.gt.0) then
             irecd=irecd-1
             call getlin(flag)
             jchar=ibkmrk(3,mark)
           endif
           depth_=0
           index_=0
           if (ibkmrk(5,mark).gt.0) then
200           call getstr
              if (depth_ .lt. 1) then
                call tbxxwarn(                                          &
     &          ' Bookmark for list, array, tuple or table corrupted')
                go to 210
              end if
              if(ibkmrk(5,mark).ne.depth_                               &
     &          .or. ibkmrk(6,mark).ne.index_ ) go to 200
           endif
210        ibkmrk(1,mark)=-1
           mark=0
         endif
         return
         end
!
!
!
!
!
!
! >>>>>> Find the location of the requested item in the CIF
!        The argument "name" may be a data item name, blank
!        for the next such item.  The argument "type" may be
!        blank for unrestricted acceptance of any non-comment
!        string (use cmnt_ to see comments), including loop headers,
!        "name" to accept only the name itself and "valu"
!        to accept only the value, or "head" to position to the
!        head of the CIF.  Except when the "head" is requested,
!        the position is left after the data item provided.
!
         function find_(name,type,strg)
!
         logical   find_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  name*(*),type*(*),strg*(*),flag*4
         character  jjbuf*(MAXBUF)
         integer    jjchar,jjrecd,jjlast,jjlrec,jjjrec,jjdepth,jindex
!
!DBG     print *,' Entering find ', name, type
         find_  = .false.
         strg   = ' '
         long_  = 0
         jjchar = jchar
         jjrecd = lrecd
         jjlast = lastch
         jjlrec = lrecd
         jjjrec = jrecd
         jjdepth = depth_
         jindex = index_
         jjbuf  = ' '
         if(lastch.gt.0) jjbuf(1:lastch)=buffer(1:lastch)
         if(type.eq.'head') then
           lrecd = min(nrecd,recend_)
           irecd = max(0,recbeg_-1)
           jchar=MAXBUF+1
           depth_=0
           call getlin(flag)
           if(flag.eq.'fini')       goto 300
           find_=.true.
           lrecd=max(0,recbeg_-1)
           return
         endif
         if(name.ne.' ') then
           testfl='no '
           call tbxxgitm(name)
           if(iname.eq.0) goto 300
           if(type.eq.'valu') then
             list_=loopnl
             strg=strg_(1:long_)
             find_=.true.
             return
           endif
           if(type.eq.'name'.or.loopnl.eq.0) then
             irecd=trecd(iname)-1
             call getlin(flag)
             jchar=tchar(iname)
             depth_=0
             posnam_=jchar+1
             call getstr
             strg=strg_(1:long_)
             recn_=irecd
             find_=.true.
             return
           endif
           if(type.eq.' ') then
             irecd=loorec(loopnl)-1
             call getlin(flag)
             jchar=loopos(loopnl)
             depth_=0
             call getstr
             posval_=loopos(loopnl)
             if(tabx_) posval_=loopox(loopnl)
             strg=strg_(1:long_)
             recn_=irecd
             find_=.true.
             return
           endif
           call tbxxerr(' Call to find_ with invalid arguments')
         endif
         if(name.eq.' ') then
           go to 200
190        if (text_.or.depth_.gt.0) then
              call getstr
              if (type_.eq.'fini')  goto 300
              if (type_.ne.'null')  goto 190  
           end if     
200        call getstr
           if(type_.eq.'fini')      goto 300
           if(type.ne.' '.and.                                          &
     &      (type_.eq.'data'.or.type_.eq.'save'.or.                     &
     &      type_.eq.'glob'))   goto 300
           if(type.eq.'name'.and.type_.ne.'name')  goto 190
           if(type.eq.'valu'.and.                                       &
     &       type_.ne.'numb'.and.type_.ne.'text'                        &
     &      .and.type_.ne.'char'.and.type_.ne.'null') goto 190
           find_=.true.
           strg=strg_(1:long_)
           if(type_.eq.'name') then
             posnam_=jchar-long_
           else
             posval_=jchar-long_
             if(quote_.ne.' '.and.quote_.ne.';')                        &
     &         posval_=posval_-1
             if(quote_.eq.'''''''' .or.quote_.eq.'"""')                 &
     &         posval_=posval_-2
           endif
           recn_=irecd
           return
         endif

!
!        Search failed, restore pointers
!
300      irecd  = jjrecd
         lastch = jjlast
         lrecd  = jjlrec
         jchar  = jjchar
         depth_ = jjdepth
         index_ = jindex

         buffer(1:1) = ' '
         if(lastch.gt.0)buffer(1:min(MAXBUF,lastch))=jjbuf(1:lastch)
         jrecd  = jjjrec
         if(jrecd.ne.irecd) jrecd=-1
         recn_  = irecd
!
         return
         end
!
!
!
!
!
!
! >>>>>> Get the next data name in the data block
!
         function name_(temp)
!
         logical    name_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  temp*(*)
!
         name_=.false.
         temp=' '
         iname=iname+1
         if(iname.gt.nname)  goto 100
         name_=.true.
         temp=dtag(iname)
         if(ddict(iname).ne.0) temp=dictag(ddict(iname))
100      return
         end
!
!
!
!
!
!
! >>>>>> Extract a number data item and its standard deviation
!        This version return single precision numbers
!
         function numb_(temp,numb,sdev)
!
         logical    numb_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  temp*(*),name*(NUMCHAR)
         integer    lname
         real       numb,sdev

!DBG     print *,'***>>> Entering numb_ for ', temp

!
         call tbxxclc(name,lname,temp,len(temp))
         if(testfl.eq.'yes')    goto 100
         if(depth_.eq.0)        goto 120
         if(name(1:1).ne.' '.and.name(1:1).ne.char(0).and.              &
     &     name(1:lname).ne.nametb(1:lnametb))     goto 120
     
         numb_ = .false.
         call getstr
         if (type_.ne.'numb') go to 200 
         if (type_.eq.'numb') then
            call ctonum
            if(posdec_.gt.0) posdec_=posval_+posdec_-1
            numb_ = .true.
            if (depth_.gt.0) jchar=jchar-1
         end if
!DBG     print *,'***>>> In numb_ strg_ ', strg_(1:long_)
         go to 200

100      if(name(1:lname).eq.nametb(1:lnametb))   goto 150
!
120      call tbxxgitm(name(1:lname))
!
150      continue
!DBG     print *,'***>>> In numb_ strg_ ', strg_(1:long_)
         numb_=.false.
         if(type_.ne.'numb') goto 200
         numb_=.true.
         numb =sngl(numbtb)
         if(sdevtb.ge.0.0) sdev=sngl(sdevtb)
!
200      testfl='no '
         return
         end
!
!
!
!
!
!
! >>>>>> Extract a number data item and its standard deviation
!        This version returns double precision numbers
!
         function numd_(temp,numb,sdev)
!
         logical    numd_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  temp*(*),name*(NUMCHAR)
         integer    lname
         double precision numb,sdev
!DBG     print *,'***>>> Entering numb_ for ', temp
!
         call tbxxclc(name,lname,temp,len(temp))
         if(testfl.eq.'yes')    goto 100
         if(depth_.eq.0)        goto 120
         if(name(1:1).ne.' '.and.name(1:1).ne.char(0).and.              &
     &     name(1:lname).ne.nametb(1:lnametb))     goto 120
     
         numd_ = .false.
         call getstr
         if (type_.ne.'numb') go to 200 
         if (type_.eq.'numb') then
            call ctonum
            if(posdec_.gt.0) posdec_=posval_+posdec_-1
            numd_ = .true.
            if (depth_.gt.0) jchar=jchar-1
         end if
!DBG     print *,'***>>> In numd_ strg_ ', strg_(1:long_)
         go to 200

100      if(name(1:lname).eq.nametb(1:lnametb))   goto 150
!
120      call tbxxgitm(name(1:lname))
!
150      numd_=.false.
!DBG     print *,'***>>> In numd_ strg_ ', strg_(1:long_)
         if(type_.ne.'numb') goto 200
         numd_=.true.
         numb =numbtb
         if(sdevtb.ge.0.0) sdev=sdevtb
!
200      testfl='no '
         return
         end
!
!
!
!
!
!
! >>>>>> Extract a character data item.
!
         function char_(temp,strg)
!
         logical    char_, charnp_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  temp*(*), strg*(*)
         integer    lstrg,nstrg

         nstrg = len(strg)
         char_ = charnp_(temp,strg,lstrg)

         if (lstrg.lt.len(strg)) strg(lstrg+1:nstrg) = ' '
         return
         end

!
!
!
!
!
!
! >>>>>> Extract a character data item, no padding.
!
         function charnp_(temp,strg,lstrg)
!
         logical    charnp_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  temp*(*),name*(NUMCHAR)
         character  strg*(*),flag*4
         integer    lstrg
         character*1 slash
         character*4 otype
         integer    ltemp, lname, klow
         integer    lastnb
!
         slash = rsolidus(1:1)
         ltemp = lastnb(temp)
         otype = type_
         call tbxxclc(name,lname,temp,ltemp)
         if(testfl.eq.'yes')    goto 100
         if(.not.text_.and.depth_.eq.0)         goto 120
         if(name(1:1).ne.' '.and.name(1:1).ne.char(0).and.              &
     &     name(1:lname).ne.nametb(1:lnametb))     goto 120
         charnp_=.false.
         lstrg = 1
         strg=' '
         call getstr
         if (type_.eq.'fini') goto 200
         if (otype.eq.'text' .and. (.not. text_) .and.long_.eq.0) then
           quote_=' '
           textfl = 'no'
           charnp_=.false.
           type_ = 'null'
           goto 200
         end if
         posval_ = jchar-long_
         posend_ = jchar-1
         if (long_.gt.0) then
            strg=strg_(1:long_)
            lstrg=long_
            if (type_.eq.'numb') then
               call ctonum
               if(posdec_.gt.0) posdec_=posval_+posdec_-1
            else 
              if (quote_.eq.' ') then
                 if (long_.eq.1.and.strg_(1:1).eq.'?') type_='null'
                 if (long_.eq.1.and.strg_(1:1).eq.'.') type_='null'
              end if
            end if
         end if
         charnp_=.true.
         goto 200
!
100      if(name(1:lname).eq.nametb(1:lnametb))     goto 150
!
120      quote_=' '
         call tbxxgitm(name(1:lname))
         text_=.false.
         if(type_.eq.'null') then
           charnp_=.false.
           text_=.false.
           textfl = 'no '
           strg_=' '
           long_=0
           goto 200
         endif
!
!        strg_(1:long_) loaded with item
!
150      charnp_=.true.
         strg(1:1)=' '
         lstrg = 1
         if(long_.gt.0) then
           strg=strg_(1:long_)
           lstrg = long_
         endif
         if(type_.eq.'char' )   goto 200
         charnp_=.false.
         if(type_.ne.'text')   goto 200
         charnp_=.true.
         call getlin(flag)
         jchar=MAXBUF+1
         if(flag.eq.'fini')    goto 200
         if(buffer(1:1).eq.';')then
           jchar=2
           textfl = 'no '
           quote_=';'
           goto 200
         endif
         irecd=irecd-1
         text_=.true.
         if (long_.gt.0) then
         if (unfold_ .and. strg(long_:long_).eq.slash) then
170        klow = long_
           long_ = long_-1
           call getlin(flag)
           if(flag.eq.'fini')    goto 210
           if(buffer(1:1).eq.';') then
             jchar=2
             textfl = 'no '
           goto 210
           endif
           quote_=' '
           jchar=lastch+1
           long_=min(len(strg_),klow+max(1,lastch)-1)
           strg_(klow:long_)=buffer(1:max(1,lastch))
           strg(long_:long_)=' '
           if(lastch.gt.0) then
             long_=min(len(strg),klow+lastch-1)
             if(long_.ge.klow) strg(klow:long_)=buffer(1:lastch)
           endif
           if( strg(long_:long_).eq.slash ) go to 170
         endif
         endif
!
200      testfl='no '
         if(long_.eq.0) strg(1:1)=' '
         lstrg = max(1,long_)
!DBG     print *,' Leaving charnp_ text_, type_, quote_: ',
!DBG *     charnp_,text_,type_,quote_
!DBG     print *, ':>>>:'//strg_(1:lstrg)
         if (type_.eq.'char' .and. quote_.eq.' ') then 
           if (strg(1:lstrg).eq.'?'.or. strg(1:lstrg).eq.'.')           &
     &       type_='null'
         end if
         return
!
210      text_ = .false.
         go to 200
!
         end
!
!
!
!
!
! >>>>>> Extract a comment or terminal delimiter field
!        backing up to a prior delimiter, depth_ will not
!        be changed even when crossing a terminal delimiter
!
         function cotdb_(strg,lstrg,istd,posstart,recstart)
!
         logical   cotdb_
         logical   istd
         integer   posstart,recstart
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character strg*(*),flag*4,c*1,                                 &
     &     jjbuf*(MAXBUF)
         integer   jjchar,jjrecd,jjlast,jjlrec,jjjrec
         integer   lstrg
         integer   ipp,itpos
         integer   klow
         character*1 slash
!
         jjchar = jchar
         jjrecd = irecd
         jjlast = lastch
         jjlrec = lrecd
         jjjrec = jrecd
         jjbuf=' '
         istd = .false.
         slash = rsolidus(1:1)
         if(lastch.gt.0)jjbuf(1:lastch)=buffer(1:lastch)
         lrecd = nrecd
         if (irecd.ne.recstart) then
           irecd = recstart-1
           call getlin(flag)
           if(flag.eq.'fini') then
             strg='fini'
             jchar=MAXBUF+1
             lstrg=4
             cotdb_=.false.
             posstart = jchar
             recstart = irecd
             go to 300
           endif
         end if
         jchar = posstart
         strg=' '
         lstrg=0
         cotdb_=.false.
100      jchar=jchar+1
         if (jchar.gt.jjchar.and.irecd.ge.jjrecd) go to 300
         if(jchar.le.lastch)     goto 140
!
!....... Read a new line
!
         call getlin(flag)
         if(flag.eq.'fini') then
           cotdb_=.false.
           posstart = jchar
           recstart = irecd
           strg='fini'
           lstrg=4
           go to 300
         endif
         jchar=0
         strg=char(0)
         lstrg=1
         posnam_=0
         quote_=' '
         goto 220
140      if(lastch.eq.1.and.buffer(1:1).eq.' ') go to 200
!
!....... Process this character in the line
!
         c=buffer(jchar:jchar)
         if(c.eq.' ')       goto 100
         if(c.eq.tab.and.(.not.tabx_)) goto 190
         if(c.eq.tab)       goto 100
         if(c.eq.'#')       goto 200
         if(depth_.gt.0 .and.                                           &
     &    ((c.eq.']'.and.rdbkt_)                                        &
     &      .or.(c.eq.')'.and.rdprn_)                                   &
     &      .or.(c.eq.'}'.and.rdbrc_))) go to 250
         goto 300
!
!        For a tab, when not expanding to blanks, accept
!        that single character as a comment
!
190      lstrg=1
         strg=tab
         posnam_=jchar
         jchar=jchar+1
         goto 220
!
!....... Accept the remainder of the line as a comment
!
200      lstrg=lastch-jchar
         quote_=buffer(jchar:jchar)
         itpos=jchar
         if(tabx_) then
           itpos=0
           do ipp=1,jchar
             itpos=itpos+1
             if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
           enddo
         endif
         posnam_=itpos
         if(lstrg.gt.0) then
           strg = buffer(jchar+1:lastch)
         endif
         if(lstrg.le.0) then
           strg=' '
           lstrg=1
         endif
         if (strg.eq.slash .and. unfold_) go to 390
         jchar=MAXBUF+1
220      cotdb_=.true.
         posstart = jchar
         recstart = irecd
         go to 300
         
!
!....... Accept the next character as a terminal delimiter
!        in a bracketed construct
!
250      lstrg=1
         quote_=' '
         posval_=jchar
         strg = buffer(jchar:jchar)
         istd =.true.
         cotdb_=.true.
         posstart = jchar
         recstart = irecd

!
!....... restore pointers and exit
!
300      irecd = jjrecd
         lastch = jjlast
         lrecd = jjlrec
         jchar = jjchar
         buffer(1:1)=' '
         if(lastch.gt.0)buffer(1:min(MAXBUF,lastch))=jjbuf(1:lastch)
         jrecd=jjjrec
         if(jrecd.ne.irecd) jrecd=-1
         recn_=irecd
         return
!
!....... Got a comment with a folding flag
!
390      klow = 1
         lrecd=jjlrec
         cotdb_=.true.
         strg(1:1)=' '
400      jjchar = MAXBUF+1
         lrecd = nrecd
         if(bloc_.eq.' ') then
           if(irecd.eq.0) jchar=MAXBUF
         endif
         lstrg=0
         go to 420
410      jchar=jchar+1
         if(jchar.le.lastch) go to 450
420      call getlin(flag)
         jchar = 1
         jjchar = 1
         if(flag.eq.'fini') then
           cotdb_=.false.
           strg='fini'
           jchar=MAXBUF+1
           lstrg=lastnb(strg)
           posstart = jchar
           recstart = irecd
           go to 300
         endif
         jchar=1
450      if(lastch.eq.1.and.buffer(1:1).eq.' ') go to 400
!
!....... Process this character in the line
!
         c=buffer(jchar:jchar)
         if(c.eq.' '.or.c.eq.tab)      goto 410
         if(c.eq.'#')       goto 470
         posstart = jchar
         recstart = irecd
         goto 300
!
!....... Accept the remainder of the line as part of the comment
!
470      lstrg=lastch-jchar
         itpos=jchar
         if(lastch.gt.jchar)                                            &
     &      strg(klow:min(len(strg),klow+lastch-2)) =                   &
     &      buffer(jchar+1:lastch)
         klow=lastnb(strg)
         if (strg(klow:klow).eq.slash) then
           strg(klow:klow)=' '
           go to 400
         endif
         jchar=MAXBUF+1
         lstrg = klow
         lrecd=jjlrec
         posstart = jchar
         recstart = irecd
         goto 300

         end
!
!
!
! >>>>>> Extract a comment or terminal delimiter field.
!
         function cotd_(strg,istd)
!
         logical   cotd_
         logical   istd
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character strg*(*),flag*4,c*1,                                 &
     &     jjbuf*(MAXBUF)
         integer   jjchar,jjrecd,jjlast,jjlrec,jjjrec
         integer   ipp,itpos
         integer   klow
         character*1 slash
!
         jjchar = jchar
         jjrecd = irecd
         jjlast = lastch
         jjlrec = lrecd
         jjjrec = jrecd
         jjbuf=' '
         istd = .false.
         slash = rsolidus(1:1)
         if(lastch.gt.0)jjbuf(1:lastch)=buffer(1:lastch)
         lrecd = nrecd
         if(bloc_.eq.' ') then
           if(irecd.eq.0) jchar=MAXBUF
         endif
         strg=' '
         long_=0
         cotd_=.false.
         if (depth_.eq.0.and.jchar.gt.0) go to 105
100      jchar=jchar+1
105      if(jchar.le.lastch)     goto 140
!
!....... Read a new line
!
         call getlin(flag)
         if(flag.eq.'fini') then
           strg='fini'
           jchar=MAXBUF+1
           long_=4
           cotd_=.false.
           return
         endif
         jchar=0
         strg=char(0)
         long_=1
         posnam_=0
         quote_=' '
         goto 220
140      if(lastch.eq.1.and.buffer(1:1).eq.' ') go to 200
!
!....... Process this character in the line
!
         c=buffer(jchar:jchar)
         if(c.eq.' ')       goto 100
         if(c.eq.tab.and.(.not.tabx_)) goto 190
         if(c.eq.tab)       goto 100
         if(c.eq.'#')       goto 200
         if(depth_.gt.0 .and.                                           &
     &    ((c.eq.']'.and.rdbkt_)                                        &
     &      .or.(c.eq.')'.and.rdprn_)                                   &
     &      .or.(c.eq.'}'.and.rdbrc_))) go to 250
         goto 300
!
!        For a tab, when not expanding to blanks, accept
!        that single character as a comment
!
190      long_=1
         strg=tab
         posnam_=jchar
         jchar=jchar+1
         goto 220
!
!....... Accept the remainder of the line as a comment
!
200      long_=lastch-jchar
         quote_=buffer(jchar:jchar)
         itpos=jchar
         if(tabx_) then
           itpos=0
           do ipp=1,jchar
             itpos=itpos+1
             if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
           enddo
         endif
         posnam_=itpos
         if(long_.gt.0) then
           strg = buffer(jchar+1:lastch)
         endif
         if(long_.le.0) then
           strg=' '
           long_=1
         endif
         if (strg.eq.slash .and. unfold_) go to 390
         jchar=MAXBUF+1
220      lrecd=jjlrec
         cotd_=.true.
         return
         
!
!....... Accept the next character as a terminal delimiter
!        in a bracketed construct
!
250      long_=1
         quote_=' '
         depth_ = depth_-1
         posval_=jchar
         strg = buffer(jchar:jchar)
         jchar=jchar+1
         lrecd=jjlrec
         istd =.true.
         cotd_=.true.
         return

!
!....... Found a non-comment field, restore pointers
!
300      irecd = jjrecd
         lastch = jjlast
         lrecd = jjlrec
         jchar = jjchar
         buffer(1:1)=' '
         if(lastch.gt.0)buffer(1:min(MAXBUF,lastch))=jjbuf(1:lastch)
         jrecd=jjjrec
         if(jrecd.ne.irecd) jrecd=-1
         recn_=irecd
         return
!
!....... Got a comment with a folding flag
!
390      klow = 1
         lrecd=jjlrec
         cotd_=.true.
         strg(1:1)=' '
400      jjchar = MAXBUF+1
         lrecd = nrecd
         if(bloc_.eq.' ') then
           if(irecd.eq.0) jchar=MAXBUF
         endif
         long_=0
         go to 420
410      jchar=jchar+1
         if(jchar.le.lastch) go to 450
420      call getlin(flag)
         jchar = 1
         jjchar = 1
         if(flag.eq.'fini') then
           strg='fini'
           jchar=MAXBUF+1
           long_=lastnb(strg)
           return
         endif
         jchar=1
450      if(lastch.eq.1.and.buffer(1:1).eq.' ') go to 400
!
!....... Process this character in the line
!
         c=buffer(jchar:jchar)
         if(c.eq.' '.or.c.eq.tab)      goto 410
         if(c.eq.'#')       goto 470
         goto 500
!
!....... Accept the remainder of the line as part of the comment
!
470      long_=lastch-jchar
         itpos=jchar
         if(lastch.gt.jchar)                                            &
     &      strg(klow:min(len(strg),klow+lastch-2)) =                   &
     &      buffer(jchar+1:lastch)
         klow=lastnb(strg)
         if (strg(klow:klow).eq.slash) then
           strg(klow:klow)=' '
           go to 400
         endif
         jchar=MAXBUF+1
         long_ = klow
         lrecd=jjlrec
         return
!
!....... Found a non-comment field, restore pointers, but return the
!        comment found so far
!
500      jchar = jjchar
         return

         end
!         
         subroutine tbxxbtab
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         if (jchar.gt.0 .and. jchar.le.lastch) then
           if (buffer(jchar:jchar).eq.tab                               &
     &      .and..not.tabx_)                                            &
     &      jchar=jchar-1
         end if
         return
         end
!         
         subroutine tbxxetab
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         if (jchar.gt.1 .and. jchar.le.lastch) then
           if (buffer(jchar-1:jchar-1).eq.tab                           &
     &      .and..not.tabx_) then
            jchar = jchar-1 
            buffer(jchar:jchar) = ' '
            end if
         end if
         return
         end
!
!
!
!
!
!
! >>>>>> Extract a comment field.
!
         function cmnt_(strg)
!
         logical   cmnt_
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character strg*(*),flag*4,c*1,                                 &
     &     jjbuf*(MAXBUF)
         integer   jjchar,jjrecd,jjlast,jjlrec,jjjrec
         integer   ipp,itpos
         integer   klow
         character*1 slash
!
         jjchar = jchar
         jjrecd = irecd
         jjlast = lastch
         jjlrec = lrecd
         jjjrec = jrecd
         jjbuf=' '
         slash = rsolidus(1:1)
         if(lastch.gt.0)jjbuf(1:lastch)=buffer(1:lastch)
         lrecd = nrecd
         if(bloc_.eq.' ') then
           if(irecd.eq.0) jchar=MAXBUF
         endif
         strg=' '
         long_=0
         cmnt_=.false.
         if (depth_.eq.0 .and. jchar.gt.0) go to 105
100      jchar=jchar+1
105      if(jchar.le.lastch)     goto 140
!
!....... Read a new line
!
         call getlin(flag)
         if(flag.eq.'fini') then
           strg='fini'
           jchar=MAXBUF+1
           long_=4
           cmnt_=.false.
           return
         endif
         jchar=0
         strg=char(0)
         long_=1
         posnam_=0
         quote_=' '
         goto 220
140      if(lastch.eq.1.and.buffer(1:1).eq.' ') go to 200
!
!....... Process this character in the line
!
         c=buffer(jchar:jchar)
         if(c.eq.' ')       goto 100
         if(c.eq.tab.and.(.not.tabx_)) goto 190
         if(c.eq.tab)       goto 100
         if(c.eq.'#')       goto 200
         goto 300
!
!        For a tab, when not expanding to blanks, accept
!        that single character as a comment
!
190      long_=1
         strg=tab
         posnam_=jchar
         jchar=jchar+1
         goto 220
!
!....... Accept the remainder of the line as a comment
!
200      long_=lastch-jchar
         quote_=buffer(jchar:jchar)
         itpos=jchar
         if(tabx_) then
           itpos=0
           do ipp=1,jchar
             itpos=itpos+1
             if(buffer(ipp:ipp).eq.tab) itpos=((itpos+7)/8)*8
           enddo
         endif
         posnam_=itpos
         if(long_.gt.0) then
           strg = buffer(jchar+1:lastch)
         endif
         if(long_.le.0) then
           strg=' '
           long_=1
         endif
         if (strg.eq.slash .and. unfold_) go to 390
         jchar=MAXBUF+1
220      lrecd=jjlrec
         cmnt_=.true.
         return
!
!....... Found a non-comment field, restore pointers
!
300      irecd = jjrecd
         lastch = jjlast
         lrecd = jjlrec
         jchar = jjchar
         buffer(1:1)=' '
         if(lastch.gt.0)buffer(1:min(MAXBUF,lastch))=jjbuf(1:lastch)
         jrecd=jjjrec
         if(jrecd.ne.irecd) jrecd=-1
         recn_=irecd
         return
!
!....... Got a comment with a folding flag
!
390      klow = 1
         lrecd=jjlrec
         cmnt_=.true.
         strg(1:1)=' '
400      jjchar = MAXBUF+1
         lrecd = nrecd
         if(bloc_.eq.' ') then
           if(irecd.eq.0) jchar=MAXBUF
         endif
         long_=0
         go to 420
410      jchar=jchar+1
         if(jchar.le.lastch) go to 450
420      call getlin(flag)
         jchar = 1
         jjchar = 1
         if(flag.eq.'fini') then
           strg='fini'
           jchar=MAXBUF+1
           long_=lastnb(strg)
           return
         endif
         jchar=1
450      if(lastch.eq.1.and.buffer(1:1).eq.' ') go to 400
!
!....... Process this character in the line
!
         c=buffer(jchar:jchar)
         if(c.eq.' '.or.c.eq.tab)      goto 410
         if(c.eq.'#')       goto 470
         goto 500
!
!....... Accept the remainder of the line as part of the comment
!
470      long_=lastch-jchar
         itpos=jchar
         if(lastch.gt.jchar)                                            &
     &      strg(klow:min(len(strg),klow+lastch-2)) =                   &
     &      buffer(jchar+1:lastch)
         klow=lastnb(strg)
         if (strg(klow:klow).eq.slash) then
           strg(klow:klow)=' '
           go to 400
         endif
         jchar=MAXBUF+1
         long_ = klow
         lrecd=jjlrec
         return
!
!....... Found a non-comment field, restore pointers, but return the
!        comment found so far
!
500      jchar = jjchar
         return

         end
!
!
!
!
!
!
! >>>>>> Return the delimiter prior to the most recently
!        examined value
!
         function delim_(depth,delim,posdlm,recdlm)
!
         logical   delim_
         integer   depth
         integer   posdlm
         integer   recdlm
         character*(*) delim

!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         delim = ' '
         delim_ = .false.
         posdlm = 0
         if (depth .ge.0 .and. depth .le.depth_) then
           delim = delimstack(depth+1)
           delim_ = .true.
           posdlm = posdlmstk(depth+1)
           recdlm = recdlmstk(depth+1)
         end if

         return

         end
!
!
!
!
!
! >>>>> Convert name string to lower case
!
         function tbxxlocs(name)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character    tbxxlocs*(MAXBUF)
         character    temp*(MAXBUF),name*(*)
         character    low*26,cap*26,c*1
         integer      i,j,kln
         integer      lastnb
         data  cap /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
         data  low /'abcdefghijklmnopqrstuvwxyz'/
!
         temp=name
         kln = lastnb(name)
         do 100 i=1,kln
         c=temp(i:i)
         j=index(cap,c)
         if(j.ne.0) temp(i:i)=low(j:j)
100      continue
         tbxxlocs=temp
         return
         end
!
!
!
!
!
! >>>>> Convert name string to lower case as subroutine
!
         subroutine tbxxnlc(loname, name)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character    temp*(MAXBUF),loname*(*),name*(*)
         character    low*26,cap*26,c*1
         integer      i,j,kln
         integer      lolen,olen
         integer      lastnb
         data  cap /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
         data  low /'abcdefghijklmnopqrstuvwxyz'/
!
         lolen = len(loname)
         olen = len(name)
         kln = min(MAXBUF,lolen,olen)
         kln = lastnb(name(1:kln))
         temp(1:kln)=name(1:kln)
         do 100 i=1,kln
         c=temp(i:i)
         j=index(cap,c)
         if(j.ne.0) temp(i:i)=low(j:j)
100      continue
         loname=temp(1:kln)
         return
         end
!
!
!
!
!
! >>>>> Convert counted name string to lower case as subroutine
!       with counts
!
         subroutine tbxxclc(loname, lloname, name, lname)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character    temp*(MAXBUF),loname*(*),name*(*)
         integer      lloname, lname
         character    low*26,cap*26,c*1
         integer      i,j,kln
         integer      lolen,olen
         integer      lastnb
         data  cap /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
         data  low /'abcdefghijklmnopqrstuvwxyz'/
!
         lolen = len(loname)
         olen = min(len(name),lname)
         kln = min(MAXBUF,lolen,olen)
         kln = lastnb(name(1:kln))
         temp(1:kln)=name(1:kln)
         do 100 i=1,kln
         c=temp(i:i)
         j=index(cap,c)
         if(j.ne.0) temp(i:i)=low(j:j)
100      continue
         loname(1:kln)=temp(1:kln)
         lloname = kln
         return
         end

!
!
!
!
!
! >>>>> Convert name string to upper case
!
         function tbxxupcs(name)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character    tbxxupcs*(MAXBUF)
         character    temp*(MAXBUF),name*(*)
         character    low*26,cap*26,c*1
         integer      i,j,kln
         integer      lastnb
         data  cap /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
         data  low /'abcdefghijklmnopqrstuvwxyz'/
!
         temp=name
         kln = lastnb(name)
         do 100 i=1,kln
         c=temp(i:i)
         j=index(low,c)
         if(j.ne.0) temp(i:i)=cap(j:j)
100      continue
         tbxxupcs=temp
         return
         end
!
!
!
!
!
! >>>>> Convert name string to upper case as subroutine
!
         subroutine tbxxnupc(upname, name)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character    temp*(MAXBUF),upname*(*),name*(*)
         character    low*26,cap*26,c*1
         integer      i,j,kln
         integer      olen,uplen
         integer      lastnb
         data  cap /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
         data  low /'abcdefghijklmnopqrstuvwxyz'/
!
         uplen = len(upname)
         olen = len(name)
         kln = min(MAXBUF,uplen,olen)
         kln = lastnb(name(1:kln))
         temp(1:kln)=name(1:kln)
         do 100 i=1,kln
         c=temp(i:i)
         j=index(low,c)
         if(j.ne.0) temp(i:i)=cap(j:j)
100      continue
         upname=temp(1:kln)
         return
         end

!
!
!
!
!
! >>>>>> Get the data item associated with the tag.
!
         subroutine tbxxgitm(name)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         SAVE
         character name*(*)
         character flag*4
         character*1 slash
         integer   iitem,nitem,npakt
         integer   kchar,loopi,i,jdict,itpos,ipp
         integer   lastnb
!
         slash = rsolidus(1:1)
!
!....... Find requested dataname in hash list
!
         lnametb=lastnb(name)
         nametb(1:lnametb)=name(1:lnametb)
!DBG     print *,' Entering tbxxgitm: ', name(1:lnametb),' ',
!DBG *     tcheck, vcheck
         posnam_=0
         posval_=0
         posdec_=0
         posend_=0
         valid_ = .false.
         quote_=' '
         jdict = 0
         strg_= ' '
         long_=1
         if(name(1:1).eq.'_')       goto 100
         type_='null'
         ttype_='    '
         depth_=0
         index_=0
         dictype_='null'
         diccat_='(none)'
         dicname_=name
         tagname_=' '
         goto 1000
100      call hash_find(nametb(1:lnametb),                              &
     &     dname,dchain,NUMBLOCK,nname,dhash,NUMHASH,                   &
     &     iname)
         if(iname.gt.0)             goto 180
         if(dictfl.ne.'yes') then
         call hash_find(nametb(1:lnametb),                              &
     &     dicnam,dicchain,NUMDICT,ndict,dichash,NUMHASH,jdict)
         if(jdict.ne.0) then
!DBG        print *,' found entry ', jdict, dicxtyp(jdict)
           dictype_=dicxtyp(jdict)
           if(dcindex(jdict).ne.0) diccat_=dcname(dcindex(jdict))
           dicname_=nametb(1:lnametb)
           if(aroot(jdict).ne.0) then
             dicname_=dictag(aroot(jdict))
             call hash_find(dicnam(aroot(jdict)),                       &
     &         dname,dchain,NUMBLOCK,nname,dhash,NUMHASH,               &
     &         iname)
             if(iname.gt.0)      goto 180
           endif
           type_='null'
           ttype_='    '
           depth_=0
           index_=0
           tagname_=' '
           strg_=' '
           long_=1
           go to 1000
         endif
         endif

         continue
         type_='null'
         ttype_='    '
         depth_=0
         index_=0
         dictype_='null'
         diccat_='(none)'
         dicname_=name
         long_=1
         goto 1000
!
!
180      tagname_=dtag(iname)
         if(ddict(iname).ne.0) tagname_=dictag(ddict(iname))
         posnam_=tchar(iname)
         if(tabx_)posnam_=xchar(iname)
         if(nloop(iname).le.0)      goto 500
!
!....... Process loop packet if first item request
!
         if(nloop(iname).ne.loopnl) goto 200
         if(lloop(iname).lt.loopct) goto 300
         if(loop_)                  goto 230
200      loop_=.true.
         depth_ = 0
         loopct=0
         loopnl=nloop(iname)
         nitem=loopni(loopnl)
         npakt=loopnp(loopnl)
         irecd=drecd(iname)-1
         call getlin(flag)
         jchar=max(0,dchar(iname)-1)
!DBG     if(jchar.lt.0) write(6,'(7H dchar ,i5)') jchar
         do 220 i=1,nitem
220      lloop(i+iname-iloop(iname))=0
         goto 240
!
!....... Read a packet of loop items
!
230      nitem=loopni(loopnl)
         npakt=loopnp(loopnl)
         irecd=looprd(nitem+1)-1
         call getlin(flag)
         jchar=loopch(nitem+1)
!DBG     if(jchar.lt.0) write(6,'(7H loopch,i5)') jchar
240      iitem=0
250      iitem=iitem+1
         quote_=' '
         text_=.false.
         if(iitem.le.nitem)     goto 255
         loopch(iitem)=jchar
         looprd(iitem)=irecd
         goto 270
255      call getstr
         loopch(iitem)=jchar-long_
         if(quote_.ne.' ') then
           if (quote_.eq.';') then
             loopch(iitem)=1
           else
             if (quote_.eq.''''''''.or.quote_.eq.'"""') then
               loopch(iitem)=jchar-long_-3
             else
               loopch(iitem)=jchar-long_-1
             end if
           end if
         end if
         loopln(iitem)=long_
         looprd(iitem)=irecd
         
         if (text_ .or.depth_ .gt. 0) then
         if (depth_.gt.0) then
           loopch(iitem)= posbrkstk(1)
           loopln(iitem)= 1
           looprd(iitem)= srecd
         end if
260        call getstr
           if (type_.eq.'fini') call tbxxerr(' Unexpected end of data')
           if (text_.or.depth_ .gt. 0) goto 260
         end if
         goto 250
270      loopct=loopct+1
         if(loopct.lt.npakt)    goto 300
         loop_=.false.
!
!....... Point to the loop data item
!
300      lloop(iname)=lloop(iname)+1
         loopi=iloop(iname)
         irecd=looprd(loopi)-1
         call getlin(flag)
         long_=loopln(loopi)
         kchar=loopch(loopi)
         if ((buffer(kchar:kchar).eq.'(' .and. rdprn_)                  &
     &     .or. (buffer(kchar:kchar).eq.'[' .and. rdbkt_)               &
     &     .or. (buffer(kchar:kchar).eq.'{' .and. rdbrc_)) then
           if (kchar.gt.1) then
             if (buffer(kchar-1:kchar-1).eq.''''                        &
     &          .or. buffer(kchar-1:kchar-1).eq.'"') goto 550
           end if
           jchar = kchar-1
           call getstr
!DBG         print *,' strg_ ', strg_(1:max(1,long_))
!DBG         print *,' depth_ ', depth_
           itpos=jchar-long_
           posval_=itpos
           posend_=itpos+long_-1
           jchar=kchar+long_
           if(jchar.le.MAXBUF) then
             if(buffer(jchar:jchar).ne.' ' .and.                        &
     &       buffer(jchar:jchar).ne.tab)                                &
     &       jchar=jchar+1
           endif
           if(type_.eq.'numb') then
             call ctonum
             if(posdec_.gt.0) posdec_=posval_+posdec_-1
           endif
           go to 1000
         end if
         goto 550
!
!....... Point to the non-loop data item
!
500      irecd=drecd(iname)-1
         call getlin(flag)
         kchar=dchar(iname)+1
         long_=iloop(iname)
         loop_=.false.
         loopct=0
         loopnl=0
!
!....... Place data item into variable string and make number
!
550      type_=dtype(iname)
         quote_=' '
         text_=.false.
         dictype_=dxtyp(iname)
         diccat_='(none)'
         if(cindex(iname).gt.0) diccat_=dcname(cindex(iname))
         if(cindex(iname).lt.0) diccat_=cname(-cindex(iname))
         if(diccat_.eq.' ') diccat_='(none)'
         dicname_=dtag(iname)
         if(ddict(iname).ne.0) then
           if (aroot(ddict(iname)).ne.0) then
             dicname_=dictag(aroot(ddict(iname)))
           endif
         endif
         strg_=' '
         if(long_.gt.0) then
!DBG       if (kchar.le.0)call tbxxwarn(' kchar le 0')
           strg_(1:long_)=buffer(kchar:kchar+long_-1)
           if ((buffer(kchar:kchar).eq.'('.and.rdprn_)                  &
     &       .or. (buffer(kchar:kchar).eq.'['.and.rdbkt_)               &
     &       .or. (buffer(kchar:kchar).eq.'{'.and.rdbrc_)) then
             if (kchar.gt.1) then
               if (buffer(kchar-1:kchar-1).eq.''''.or.                  &
     &           buffer(kchar-1:kchar-1).eq.'"') then
                 go to 555
               end if        
             end if
!DBG         print *,' getitm: kchar, irecd ',kchar,irecd
             jchar = kchar-1
!DBG         print *,' strg_ ', strg_(1:max(1,long_))
             call getstr
             if(type_.eq.'numb') then
               call ctonum
               if(posdec_.gt.0) posdec_=posval_+posdec_-1
             endif
!DBG         print *,' strg_ ', strg_(1:max(1,long_))
!DBG         print *,' depth_ ', depth_
             go to 1000
           end if
         endif
555      itpos=kchar
         posval_=itpos
         posend_=itpos+long_-1
         jchar=kchar+long_
         if(jchar.le.MAXBUF) then
           if(buffer(jchar:jchar).ne.' ' .and.                          &
     &       buffer(jchar:jchar).ne.tab) jchar=jchar+1
         endif
         quote_=' '
         if(kchar.gt.1) then
           if(buffer(kchar-1:kchar-1).ne.' ' .and.                      &
     &        buffer(kchar-1:kchar-1).ne.tab) then
             quote_=buffer(kchar-1:kchar-1)
             if (kchar.gt.3.and.rdtq_) then
               if (buffer(kchar-3:kchar-1).eq.                          &
     &           quote_//quote_//quote_) then
                 quote_ = buffer(kchar-3:kchar-1)
               end if
             end if
           endif
         endif
         if(type_.eq.'char' .and. kchar.eq.1 .and.                      &
     &     buffer(1:1).eq.';') then
           type_='text'
           fold_=.false.
           quote_=';'
         endif
         if(type_.eq.'text') then
           if(buffer(1:1).eq.';') then
             quote_=';'
             if (clipt_.or.long_.lt.2) then
             strg_(1:1)=' '
             if (strg_(1:long_).eq.(' '//slash) ) then
               fold_=.true.
               if(unfold_) then
                 strg_(1:long_)=slash
                   long_=1
                 endif
               endif
             else
               do ipp = 2,long_
                 strg_(ipp-1:ipp-1)=strg_(ipp:ipp)
               end do
               long_=long_-1
               if (strg_(1:long_).eq.slash) then
                 fold_=.true.
                 if (unfold_) then
                 long_=1
                 endif
               endif
             endif
           else
             type_='char'
             if (quote_.eq.';') quote_=' '
           endif
         endif
         if(type_.eq.'numb') then
           call ctonum
           if(posdec_.gt.0) posdec_=posval_+posdec_-1
         endif
         if(type_.eq.'char' .and. strg_.eq.' '.and.nblank_)             &
     &     type_='null'
         if (quote_.ne.' ') goto 1000
         if (long_.eq.1.and.strg_(1:1).eq.'?') type_='null'
         if (long_.eq.1.and.strg_(1:1).eq.'.') type_='null'
         if (tcheck.eq.'yes') then
           call hash_find(nametb(1:lnametb),                            &
     &       dicnam,dicchain,NUMDICT,ndict,dichash,NUMHASH,jdict)
           if (jdict.gt.0)                                              &
     &     call tbxxckv(jdict)
         endif
!
1000     return
         end

!
!
!
!
!
!
!
! >>>>>> Convert string to integer, marking non-digit
!
!
         function tbxxsti(xstr,nondig)
         integer tbxxsti
         character *(*) xstr
         integer nondig, i
         integer sign, digits, kdv

         tbxxsti = 0
         digits = 0
         nondig = 0
         sign = 1
         do i = 1,len(xstr)
           kdv = ichar(xstr(i:i))-ichar('0')
           if (digits.eq.0) then
             if (xstr(i:i).eq.'-') then
               sign = -1
               digits = 1
             else
               if (xstr(i:i).eq.'+') then
                 sign = 1
                 digits = 1
               else
                 if (kdv.ge.0 .and. kdv.le.9) then
                   digits = 1
                   tbxxsti = kdv
                 else
                   if (xstr(i:i).ne.' ') then
                     nondig = i
                     return
                   endif
                 endif
               endif
             endif
           else
             if (kdv.ge.0 .and.kdv.le.9) then
               tbxxsti = tbxxsti*10+kdv
             else
               tbxxsti = sign*tbxxsti
               nondig = i
               return
             endif
           endif
         enddo
         tbxxsti = sign*tbxxsti
         return

         end



!
!
!
!
!
!
!
! >>>>>> Convert string to double, marking non-digit
!
!
         function tbxxstd(xstr,nondig)
         double precision tbxxstd
         integer tbxxsti
         character *(*) xstr
         integer nondig, i
         integer sign, digits, kdv
         integer idp, eval
         tbxxstd = 0.0
         digits = 0
         nondig = 0
         sign = 1
         idp = 0
         do i = 1,len(xstr)
           kdv = ichar(xstr(i:i))-ichar('0')
           if (i.lt.len(xstr)                                           &
     &       .and. (xstr(i:i).eq.'e'                                    &
     &       .or. xstr(i:i).eq.'E'                                      &
     &       .or. xstr(i:i).eq.'d'                                      &
     &       .or. xstr(i:i).eq.'D'                                      &
     &       .or. xstr(i:i).eq.'q'                                      &
     &       .or. xstr(i:i).eq.'Q')) then
             eval = tbxxsti(xstr(i+1:len(xstr)),nondig)
             tbxxstd = sign*tbxxstd*10.**eval
             if (nondig.ne.0) nondig=nondig+i+1
             return
           endif
           if (i.lt.len(xstr) .and. digits .ne.0                        &
     &       .and. (xstr(i:i).eq.'+'                                    &
     &       .or. xstr(i:i).eq.'-')) then
             eval = tbxxsti(xstr(i:len(xstr)),nondig)
             tbxxstd = sign*tbxxstd*10.**eval
             if (nondig.ne.0) nondig=nondig+i
             return
           endif
           if (xstr(i:i).eq.'.'.and.idp.eq.0) then
             idp = i
             digits = 1
           endif
           if (digits.eq.0) then
             if (xstr(i:i).eq.'-') then
               sign = -1
               digits = 1
             else
               if (xstr(i:i).eq.'+') then
                 sign = 1
                 digits = 1
               else
                 if (kdv.ge.0 .and. kdv.le.9) then
                   digits = 1
                   tbxxstd = kdv
                 else
                   if (xstr(i:i).ne.' ') then
                     nondig = i
                     return
                   endif
                 endif
               endif
             endif
           else
             if (kdv.ge.0 .and.kdv.le.9) then
               if (idp.eq.0) then
                 tbxxstd = tbxxstd*10.+kdv
               else
                 tbxxstd = tbxxstd+kdv*(10.**(idp-i))
               endif
             else
               if (i.ne.idp) then
                 tbxxstd = sign*tbxxstd
                 nondig = i
                 return
               endif
             endif
           endif
         enddo
         tbxxstd = sign*tbxxstd
         return

         end


!
!
!
!
!
!
!
! >>>>>> Validate the string in strg_(1:long_) of type type_
!        against the dictionary item at jdict
!
!
         subroutine tbxxckv(jdict)
         integer jdict
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 

         character*(MAXBUF) temp, target, lcvalue
         integer tbxxfstb
         integer tbxxsti
         double precision tbxxstd
         integer tlen
         logical igood, isword, nolo, nohi
         integer fblank,ftab, symop, xlate
         integer yyyy, mm, dd, hr, mi, se, sf, tz
         integer nondig, prevdig, ldt, ldn
         logical enumflg
         integer lastnb
         integer kptr, ltarget, icptr
         integer ilolo, ilohi, ihilo, ihihi
         integer llcvalue

         valid_ = .false.
         igood = .false.
         enumflg = .false.
         kptr = 0
         if (long_ .lt. 1) return

         fblank = index(strg_(1:long_),' ')
         ftab = index(strg_(1:long_),tab)
         ldt = max(1,lastnb(dictype_))
         ldn = max(1,lastnb(dicnam(jdict)))
         isword = .true.
         if (fblank.ne.0 .or. ftab.ne.0) isword =.false.

         if (type_.eq.'null') igood = .true.

         if ((type_.eq.'char' .or. type_.eq. 'numb').and. isword) then
           if (dictype_.eq.'uchar3') then
             if (long_.eq.3.or.                                         &
     &            (long_.eq.4.and.strg_(1:1).eq.'+')                    &
     &            ) igood = .true.
             go to 90
           endif

           if (dictype_.eq.'uchar1') then
             if (long_.eq.1.or.                                         &
     &            (long_.eq.2.and.strg_(1:1).eq.'+')                    &
     &          ) igood = .true.
             go to 90
           endif

           if (dictype_(1:4).eq.'symo') then
             symop = tbxxsti(strg_(1:long_),nondig)
             xlate = 0
             if (nondig.ne.0.and.nondig.lt.long_) then
               if (strg_(nondig:nondig).eq.'_') then
                 xlate = tbxxsti(strg_(nondig+1:long_),nondig)
               endif
             endif

             if (nondig.eq.0 .and.                                      &
     &         symop .ge. 1 .and.                                       &
     &         symop .le. 192 .and.                                     &
     &         xlate .ge. 0 .and.                                       &
     &         xlate .le. 1000) igood =.true.
             go to 90
           endif

           if (dictype_(1:5).eq.'yyyy-') then

             mm=-1
             dd=-1
             hr=0
             mi =0
             se=0
             sf=0
             tz = 0

             yyyy = tbxxsti(strg_(1:long_),nondig)
             if (nondig.ne.0.and.nondig.lt.long_) then
             if (strg_(nondig:nondig).eq.'-') then
               prevdig = nondig
               mm = tbxxsti(strg_(nondig+1:long_),nondig)
               if (nondig.ne.0) nondig=prevdig+nondig
               if (nondig.ne.0.and.nondig.lt.long_) then
               if (strg_(nondig:nondig).eq.'-') then
                 prevdig = nondig
                 dd = tbxxsti(strg_(nondig+1:long_),nondig)
                 if (nondig.ne.0) nondig=prevdig+nondig
                 if (nondig.ne.0.and.nondig.lt.long_) then
                 if (strg_(nondig:nondig).eq.'T'                        &
     &             .or. strg_(nondig:nondig).eq.'t'                     &
     &             .or. strg_(nondig:nondig).eq.':') then
                   prevdig = nondig
                   hr = tbxxsti(strg_(nondig+1:long_),nondig)
                   if (nondig.ne.0) nondig=prevdig+nondig
                   if (nondig.ne.0.and.nondig.lt.long_) then
                   if (strg_(nondig:nondig).eq.':') then
                     prevdig = nondig
                     mi = tbxxsti(strg_(nondig+1:long_),nondig)
                     if (nondig.ne.0) nondig=prevdig+nondig
                     if (nondig.ne.0.and.nondig.lt.long_) then
                     if (strg_(nondig:nondig).eq.':') then
                       prevdig = nondig
                       se = tbxxsti(strg_(nondig+1:long_),nondig)
                       if (nondig.ne.0) nondig=prevdig+nondig
                       if (nondig.ne.0.and.nondig.lt.long_) then
                       if (strg_(nondig:nondig).eq.'.') then
                         prevdig = nondig
                         sf = tbxxsti(strg_(nondig+1:long_),nondig)
                         if (nondig.ne.0) nondig=prevdig+nondig
                       endif
                       endif
                     endif
                     endif
                   endif
                   endif
                 endif
                 endif
               endif
               endif
             endif
             endif
             if (nondig.ne.0) then
             if (strg_(nondig:nondig).eq.'-'                            &
     &         .or. strg_(nondig:nondig).eq.'+') then
               tz = tbxxsti(strg_(nondig+1:long_),nondig)
             endif
             endif
             if (nondig.eq.0                                            &
     &         .and. yyyy .ge. 0  .and. yyyy .lt. 10000                 &
     &         .and. mm .gt. 0 .and. mm .lt. 13                         &
     &         .and. dd .gt. 0 .and. dd .lt. 32                         &
     &         .and. hr .ge. 0 .and. hr .lt. 25                         &
     &         .and. mi .ge. 0 .and. mi .lt. 61                         &
     &         .and. se .ge. 0 .and. se .lt. 61                         &
     &         .and. sf .ge. 0                                          &
     &         .and. tz .ge. 0 .and. tz .lt. 25 ) igood =.true.
             go to 90
           endif

           if (dictype_(1:4).eq.'char'                                  &
     &       .or. dictype_(1:4).eq.'ucha'                               &
     &       .or. dictype_(1:4).eq.'code'                               &
     &       .or. dictype_(1:4).eq.'ucod'                               &
     &       .or. dictype_(1:4).eq.'line'                               &
     &       .or. dictype_(1:4).eq.'ulin'                               &
     &       .or. dictype_(1:3).eq.'any'                                &
     &       .or. dictype_(1:4).eq.'atco'                               &
     &       .or. dictype_(1:4).eq.'phon'                               &
     &       .or. dictype_(1:4).eq.'emai'                               &
     &       .or. dictype_(1:4).eq.'fax'                                &
     &       .or. dictype_(1:4).eq.'text')  then
             igood = .true.
             go to 90
           endif

           if (dictype_(1:4).eq.'numb'                                  &
     &       .or. dictype_(1:3).eq.'int'                                &
     &       .or. dictype_(1:4).eq.'floa') then
             tbxxintr = tbxxsti(strg_(1:long_),nondig)
             if (nondig.eq.0) then
               igood = .true.
               go to 90
             endif
             if (strg_(nondig:nondig).eq.'('                            &
     &         .and. nondig .lt. long_) then
               tbxxintr = tbxxsti(strg_(nondig+1:long_),nondig)
               if (nondig.gt.0) then
                 if (strg_(nondig:nondig).eq.')') then
                   igood = .true.
                   go to 90
                 endif
               endif
             endif
             if (dictype_(1:4).eq.'numb'                                &
     &         .or. dictype_(1:4).eq.'floa') then
               if (type_.eq.'numb') igood = .true.
             endif
             go to 90
           endif
           go to 90
         endif

         if (type_.eq.'char') then
           if (dictype_(1:4).eq.'text'                                  &
     &       .or. dictype_(1:3).eq.'any'                                &
     &       .or. dictype_(1:4).eq.'line'                               &
     &       .or. dictype_(1:4).eq.'ulin'                               &
     &       .or. dictype_(1:4).eq.'phon'                               &
     &       .or. dictype_(1:4).eq.'atco'                               &
     &       .or. dictype_(1:4).eq.'phon'                               &
     &       .or. dictype_(1:4).eq.'char'                               &
     &       .or. dictype_(1:4).eq.'ucha' ) igood = .true.
           go to 90
         endif

         if (type_.eq.'text') then
           if (dictype_(1:4).eq.'text'                                  &
     &       .or. dictype_(1:3).eq.'any'                                &
     &       .or. dictype_(1:4).eq.'char'                               &
     &       .or. dictype_(1:4).eq.'ucha' ) igood = .true.
           go to 90
         endif


 90      continue

         if (.not.igood) then
           call tbxxwarn(' Dictionary type '//dictype_(1:ldt)//         &
     &     ' for '//dicnam(jdict)(1:ldn)//                              &
     &     ' not matched by '//strg_(1:long_))
           return
         endif
         kptr = deindex(jdict)
         if (kptr.eq.0 .or. type_.eq.'null') then
           valid_ = .true.
           return
         endif



         call tbxxclc(lcvalue,llcvalue,strg_,long_)

100      if (kptr.ne.0) then

           tlen = tbxxfstb(temp,ivtsbp(kptr),.false.)
           if (tlen.gt.0) then
             call tbxxclc(target,ltarget,temp,tlen)
             if (ivtvet(kptr) .eq. 0) then
               enumflg = .true.
               if (target(1:ltarget).eq.lcvalue(1:llcvalue)) then
                 valid_ = .true.
                 return
               endif
               if(type_.eq.'numb'                                       &
     &           .and. (dictype_(1:4).eq.'numb'                         &
     &              .or. dictype_(1:3).eq.'int'                         &
     &              .or. dictype_(1:4).eq.'floa')) then
                 if (tbxxstd(target(1:ltarget),nondig)                  &
     &              .eq.numbtb) then
                    valid_= .true.
                    return
                 endif
               endif
             else
               enumflg = .false.
               icptr = index(target(1:ltarget),':')
               ilolo = 1
               ilohi = icptr-1
               ihilo = icptr+1
               ihihi = ltarget
               nolo = .true.
               if (ilohi.ge.ilolo) then
                 nolo = .false.
                 if (target(ilolo:ilohi).eq.'.')                        &
     &             nolo = .true.
               endif
               nohi = .true.
               if (ihihi.ge.ihilo) then
                 nohi = .false.
                 if (target(ihilo:ihihi).eq.'.')                        &
     &             nohi = .true.
               endif
              if (dictype_(1:4).eq.'numb'                               &
     &         .or. dictype_(1:3).eq.'int'                              &
     &         .or. dictype_(1:4).eq.'floa') then
              if (nolo.and.(.not.nohi)) then
                 if ((ivtvet(kptr).gt.0                                 &
     &             .and. numbtb .lt.                                    &
     &               tbxxstd(target(ihilo:ihihi),nondig)) .or.          &
     &               (ivtvet(kptr).lt.0                                 &
     &             .and. numbtb .le.                                    &
     &               tbxxstd(target(ihilo:ihihi),nondig))) then
                   valid_= .true.
                   return
                 endif
               endif
               if (nohi.and.(.not.nolo)) then
                 if ((ivtvet(kptr).gt.0                                 &
     &             .and. numbtb .gt.                                    &
     &               tbxxstd(target(ilolo:ilohi),nondig)) .or.          &
     &               (ivtvet(kptr).lt.0                                 &
     &             .and. numbtb .ge.                                    &
     &               tbxxstd(target(ilolo:ilohi),nondig))) then
                   valid_= .true.
                   return
                 endif
               endif
               if ((.not.nohi).and.(.not.nolo)) then
                 if ((ivtvet(kptr).gt.0                                 &
     &             .and. numbtb .lt.                                    &
     &               tbxxstd(target(ihilo:ihihi),nondig)                &
     &             .and. numbtb .gt.                                    &
     &               tbxxstd(target(ilolo:ilohi),nondig)) .or.          &
     &               (ivtvet(kptr).lt.0                                 &
     &             .and. numbtb .le.                                    &
     &               tbxxstd(target(ihilo:ihihi),nondig)                &
     &             .and. numbtb .ge.                                    &
     &               tbxxstd(target(ilolo:ilohi),nondig))) then
                   valid_= .true.
                   return
                 endif
               endif
               else
               if (nolo.and.(.not.nohi)) then
                 if ((ivtvet(kptr).gt.0                                 &
     &             .and. lcvalue(1:llcvalue) .lt.                       &
     &               target(ihilo:ihihi)) .or.                          &
     &               (ivtvet(kptr).lt.0                                 &
     &             .and. lcvalue(1:llcvalue) .le.                       &
     &               target(ihilo:ihihi))) then
                   valid_= .true.
                   return
                 endif
               endif
               if (nohi.and.(.not.nolo)) then
                 if ((ivtvet(kptr).gt.0                                 &
     &             .and. lcvalue(1:llcvalue) .gt.                       &
     &               target(ilolo:ilohi)) .or.                          &
     &               (ivtvet(kptr).lt.0                                 &
     &             .and. lcvalue(1:llcvalue) .ge.                       &
     &               target(ilolo:ilohi))) then
                   valid_= .true.
                   return
                 endif
               endif
               if ((.not.nohi).and.(.not.nolo)) then
                 if ((ivtvet(kptr).gt.0                                 &
     &             .and. lcvalue(1:llcvalue) .lt.                       &
     &               target(ihilo:ihihi)                                &
     &             .and. lcvalue(1:llcvalue) .gt.                       &
     &               target(ilolo:ilohi)) .or.                          &
     &               (ivtvet(kptr).lt.0                                 &
     &             .and. lcvalue(1:llcvalue) .le.                       &
     &               target(ihilo:ihihi)                                &
     &             .and. lcvalue(1:llcvalue) .ge.                       &
     &               target(ilolo:ilohi))) then
                   valid_= .true.
                   return
                 endif
               endif
              endif
             endif
           endif
           kptr = ivtnxt(kptr)
           go to 100
         endif
         continue
         if (enumflg) then
           call tbxxwarn(' Dictionary type '//dictype_(1:ldt)//         &
     &      ' for '//dicnam(jdict)(1:ldn)//', '//                       &
     &      strg_(1:long_)//                                            &
     &      ' not in dictionary list of values')
         else
         call tbxxwarn(' Dictionary type '//dictype_(1:ldt)//           &
     &      ' for '//dicnam(jdict)(1:ldn)//                             &
     &      ' range not matched by '//strg_(1:long_))
         endif

         return
         end
!
!
!
!
!
!
!
!
! >>>>>> Test for separator
!
!
       logical function tbxxtsts(c)
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
       character*1 c
       tbxxtsts = .true.
       if (rdrcqt_) return
       if (c.eq.' ') return
       if (c.eq.tab) return
       tbxxtsts = .false.
       if (depth_ .eq. 0) return
       if (c.eq.',' .or.                                                &
     &   c.eq.':' .or.                                                  &
     &   ((c.eq.')'.or.c.eq.'(') .and. rdprn_) .or.                     &
     &   ((c.eq.'}'.or.c.eq.'{') .and. rdbrc_) .or.                     &
     &   ((c.eq.']'.or.c.eq.'[') .and. rdbkt_) ) then
         tbxxtsts=.true.
         return
       end if
       return
       end
!
!
!
!
!
!
!
!
! >>>>>> Test for terminal treble quote
!
!      tests buffer(jchar:lastch) for a terminal treble quote
!      and returns the location in jtloc
!
!
       logical function tbxxtttq(jtloc)
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
       character*1 slash
       logical escaped
       logical tbxxtsts
       integer i,jtloc

       slash = rsolidus(1:1)
       tbxxtttq = .false.
       jtloc = jchar

       if (rdrcqt_) then

!        Process according to CIF2 rules on quotes
         escaped = .false.
         if (jchar .le. lastch-2) then
           do i = jchar,lastch-2
             if (.not.escaped) then
               if (buffer(i:i).eq.slash) then
                 escaped = .true.
               else
                 if (buffer(i:i+2).eq.quote_) then
                   jtloc = i
                   tbxxtttq = .true.
                   return
                 end if
               end if
             else
               escaped=.false.
             end if
           end do
         end if
         return
       else
!
!        Process according to CIF1 rules
         if (jchar .le. lastch-2) then
           do i = jchar,lastch-2
             if (buffer(i:i+2).eq.quote_) then
               if (i.lt.lastch-2) then
                 if (tbxxtsts(buffer(i+3:i+3))) then
                   jtloc = i
                   tbxxtttq = .true.
                   return
                 end if
               else
                 jtloc = i
                 tbxxtttq = .true.
                 return
               end if
             end if
           end do
         end if
         return
       end if
         end


!
!
!
!
!
!
!
! >>>>>> Read the next string from the file
!
!
       subroutine getstr
!
!      On entry, jchar is set to one less than the next character
!      to be read, on the line given by irecd, which is assumed
!      to have been loaded into buffer, with lastch set to the
!      position of the last character
!
!      if depth_ is greater than 0, then statestack(depth_),
!      brackstack(depth_) and indexstack(depth_) give the
!      state of the scan within a list, array, tuple of table
!
!      If the state is 0, we are starting a search for a token
!      if the state is 2, we had a token last pass and need
!      to find a comma, colon or a terminating ) ] or } before looking
!      for the next token.
!
!      On entry, the state of text_ is used to determine if we are continuing
!      a text field or a bracketed construct.  The case of a text field within
!      a bracketed construct is handled by checking quote_.  If it is any of
!      ';', "'''", or '"""', then the next line needs to be read if text_ is
!      true.  If it any any other string, then the next element of the
!      bracketed construct needs to be read
!
!      If the depth is zero, text_ will be cleared one getstr call
!      prior to the last, empty read.  This change is not made for treble
!      quoted strings
!
!      In a bracketed construct text_ will be left set after the read
!      of the last read with text and the next read will return a null
!      type_
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
       integer   i,j,jj(11),im,ip
       integer   state,innerdepth
       logical   quoted
       logical   escaped
       character c*1,num*21,flag*4
       character slash*1
       logical   tbxxtsts, tbxxtttq
       integer   jtloc

       data num/'0123456789+-.()EDQedq'/
       slash = rsolidus(1:1)
       im = 0
!DBG   print *,' entering getstr type, text_, quote_, depth_ jchar: '
!DBG   print *,  type_, text_, quote_, depth_, jchar


!      If text_ is true, we may be continuing a text field, a
!      treble-quoted string or a bracketed construct
!
!      We deal with the first 2 cases here
!
       if (text_) then
         if (quote_.eq.';'.or.quote_.eq.'"""'.or.quote_.eq."'''") then
!DBG     print *,' processing next line'
           call getlin(flag)
           if (flag.eq.'fini') then
             type_='fini'
             text_=.false.
             depth_=0
             ttype_='    '
             depth_=0
             quote_=' '
             quoted=.false.
             goto 500
           end if
!
!          Handle the case of a text field
!          This is terminated by \n; which
!          is unconditionally recognized if rdrcqt_ is true
!          or which requires a trailing separator if depth_
!          is greater than 0

!DBG   print *, 'read line:',buffer(1:lastch)
           if (quote_.eq.';') then
!DBG     print *, 'semicolon quote_ detected'
             if (buffer(1:1).eq.';') then
!DBG         print *, 'terminal semicolon detected'
               if (lastch.gt.1) then
                 if (.not.tbxxtsts(buffer(2:2))) goto 10
               end if
               jchar = 2
               long_ = 0
               strg_(1:1) = ' '
               text_=.false.
               quote_ = ' '
               type_='null'
               goto 500
             end if
!            Here is the line we have read is part of the text field
10           continue
!DBG         print *,'processing as text field'
             jchar = lastch+1
             strg_(1:lastch) = buffer(1:lastch)
!DBG         print *, ' buffer before backup ', buffer(1:lastch)
             long_ = lastch
             text_ = .true.
             
             if (depth_.eq.0) then
               call getlin(flag)
               if(flag.eq.'fini') then
                 text_ = .false.
               else
                 if (buffer(1:1).eq.';') then
                   text_ = .false.
                   jchar = 2
                 end if
               end if
               if (text_) then
                 irecd = irecd-1
                 jchar=MAXBUF+1
               else
                 go to 500
               endif
!DBG         print *, ' buffer after backup ', buffer(1:lastch)
             end if
             goto 500
           else
!
!          Handle the case of a treble-quoted string
!          This is terminated by an unescaped quote
!
             if (tbxxtttq(jtloc)) then
               long_ = jtloc-jchar
               if (long_.eq.0) then
                 long_=0
                 strg_(1:1) = ' '
               else
                 strg_(1:long_)=buffer(jchar:jtloc)
               end if
               jchar = jtloc+3
               text_=.false.
               goto 500
             else
               jchar = lastch+1
               strg_(1:lastch) = buffer(1:lastch)
               long_ = lastch
               text_ = .true.
               goto 500
             end if
           end if
         end if
       end if
!
!      Now we are sure we are done with the multiline quoted cases
       quoted=.false.
       quote_=' '
       ttype_=' '
       if (depth_ .gt. 0) then
         ttype_ = typestack(1)
         type_ = typestack(depth_)
         state = statestack(depth_)
         index_= indexstack(depth_)
         go to 3000
       end if

!      We are not in a bracketed construct

       if(irecd.gt.0.and.                                               &
     &   jchar.le.1.and.lastch.gt.0) then
         jchar=1
         goto 140
       end if
100    jchar=jchar+1
       if(jchar.le.lastch)     goto 150
!
!....... Read a new line
!
110    call getlin(flag)
       type_='fini'
       dictype_=type_
       diccat_='(none)'
       dicname_=' '
!DBG   write(6,'(/5i5,a)')
!DBG *   irecd,jrecd,lrecd,nrecd,lastch, buffer(1:lastch)
       if(flag.eq.'fini')  goto 500
!
!....... Test if the new line is the start of a text sequence
!
140    if(buffer(1:1).ne.';') goto 150
       type_='text'
       quote_=';'
       jchar=lastch+1
       long_=lastch
       if (clipt_) then
         strg_(1:long_)=buffer(1:long_)
         strg_(1:1)=' '
       else
         if (long_.eq.1) then
           strg_(1:long_) = ' '
           long_ = 0
         else
           long_ = long_-1
           strg_(1:long_)=buffer(2:long_+1)
         endif
       endif
       text_ = .true.
       goto 500
!
!....... Process this character in the line
!
150    c=buffer(jchar:jchar)
       ip = jchar
       if(c.eq.' ')       goto 100
       if(c.eq.tab)       goto 100
       if(c.eq.'#')       goto 110
       if(c.eq.'''')      goto 300
       if(c.eq.'"')       goto 300
       if(c.eq.'('.and.rdprn_)       goto 350
       if(c.eq.'['.and.rdbkt_)       goto 360
       if(c.eq.'{'.and.rdbrc_)       goto 370
       if(c.ne.'_')       goto 200

       type_='name'
       goto 210
!
!....... Span blank delimited token; test if a number or a character
!
200    type_='numb'
       im=0
       quoted=.false.
       quote_=' '
       do 205 i=1,11
205    jj(i)=0
210    ip = jchar
       do 250 i=jchar,lastch
         ip = i
         if(buffer(i:i).eq.' ')       goto 400
         if(buffer(i:i).eq.tab)       goto 400
         if(type_.ne.'numb')          goto 250
         j=index(num,buffer(i:i))
         if(j.eq.0)                 type_='char'
         if(j.le.10) then
           im=im+1
           goto 250
         endif
         if(j.gt.13.and.im.eq.0) type_='char'
         jj(j-10)=jj(j-10)+1
250    continue
       i=lastch+1
       ip = i
       if(type_.ne.'numb') goto 400
       do 270 j=1,5
         if((jj(j).gt.1.and.j.gt.2) .or.                                &
     &     jj(j).gt.2)             type_='char'
270    continue
       goto 400       
!
!....... Span quote delimited token; assume character
!
300    type_='char'
       quoted=.true.
       jchar=jchar+1
       if (rdtq_ .and. jchar+1 .le. lastch                              &
     &   .and. buffer(jchar:jchar+1).eq.c//c) then
         quote_ = c//c//c
         jchar = jchar+2
         if (tbxxtttq(jtloc)) then
           text_=.false.
         else
           jtloc = lastch
           text_=.true.
           type_='text'
         endif
         long_ = jtloc-jchar
         if (long_.eq.0) then
           strg_=' '
         else
           strg_(1:long_)=buffer(jchar:jtloc)
         endif
         goto 500
       end if
       escaped = .false.
       ip = jchar
       do 320 i=jchar,lastch
         ip = i
         if (.not.escaped.and.rdrcqt_) then
           if (c.eq.slash) then
             escaped = .true.
             go to 320
           end if
         end if
         if (escaped) then
           escaped = .false.
           go to 320
         end if
         if(buffer(i:i).ne.c)             goto 320
         if(rdrcqt_)                      goto 400
         if(i+1.ge.lastch)                goto 400
         if (tbxxtsts(buffer(i+1:i+1)))   goto 400
320    continue
!DBG   write(6,'(a,4i5,a)')
!DBG *     '**** ',irecd,lastch,i,jchar,buffer(jchar:i)
       call tbxxwarn(' Quoted string not closed')
       i = lastch+1
       goto 400

!
!...... Here to start a bracketed construct
!
350    type_='tupl'
       go to 390
360    type_='list'
       go to 390
370    type_='tabl'
       if (.not. rdbkt_) type_='list'
390    depth_=1
       srecd=irecd
       ttype_=type_
       typestack(depth_) = type_
       brackstack(depth_) = c
       posbrkstk(depth_) = ip
       if (c.eq.':') brackstack(depth_) = ' '
       delimstack(depth_+1) = c
       posdlmstk(depth_+1) = ip
       recdlmstk(depth_+1) = irecd
       indexstack(depth_) = 1
       statestack(depth_) = 0
       state = 0
       go to 3100

!
!....... Here to process within a bracketed construct
!
3000   continue
!DBG   print *,' Processing in backeted construct '
       if(irecd.gt.0.and.                                               &
     &   jchar.le.1.and.lastch.gt.0) then
         jchar=1
         goto 3140
       endif

3100   jchar = jchar+1
       if(jchar.le.lastch)     goto 3150
!
!....... Read a new line
!
3110   call getlin(flag)
       if(flag.eq.'fini')  goto 3500

!
!....... Test if the new line is the start of a text sequence
!
3140   continue
!DBG   print *,buffer(jchar:lastch)
       if (buffer(1:1).ne.';') goto 3150
         type_='text'
         quote_=';'
         jchar=lastch+1
         long_=lastch
         if (long_ .gt. 1) then
         if (clipt_) then
           strg_(2:long_)=buffer(2:long_)
           strg_(1:1) = ' '
         else
           strg_(1:long_-1)=buffer(2:long_)
         long_ = long_-1
         endif
       else
         strg_(1:1)=' '
         long_ = 0
       endif
       state = 2
       statestack(depth_) = 2
       goto 500
!
!..... Process this character in the line
!      within a bracket construct
!
3150   continue
!DBG   print *,buffer(jchar:lastch)
       c=buffer(jchar:jchar)
       ip = jchar
       if(c.eq.' ')       goto 3100
       if(c.eq.tab)       goto 3100
       if(c.eq.'#')       goto 3110
       if(c.eq.'''')      goto 3300
       if(c.eq.'"')       goto 3300
       if(c.eq.'('.and.rdprn_)       goto 3350
       if(c.eq.'['.and.rdbkt_)       goto 3360
       if(c.eq.'{'.and.rdbrc_)       goto 3370
       if(c.eq.':'.and.rdcolon_)     goto 3380
       if(c.eq.',')       goto 3160
       if((c.eq.')' .and. brackstack(depth_).eq.'(') .or.               &
     &   (c.eq.'}' .and. brackstack(depth_).eq.'{') .or.                &
     &   (c.eq.']' .and. brackstack(depth_).eq.'[')) goto 3160
       if(c.eq.')' .and.                                                &
     &   ((brackstack(depth_).eq.'{').or.                               &
     &   (brackstack(depth_).eq.'[')))                                  &
     &     call tbxxwarn(' Unbalanced ) treated as comma')
       if(c.eq.']' .and.                                                &
     &   ((brackstack(depth_).eq.'{').or.                               &
     &   (brackstack(depth_).eq.'(')))                                  &
     &     call tbxxwarn(' Unbalanced ] treated as comma')
       if(c.eq.'}' .and.                                                &
     &   ((brackstack(depth_).eq.'(').or.                               &
     &   (brackstack(depth_).eq.'[')))                                  &
     &     call tbxxwarn(' Unbalanced } treated as comma')
       go to 3200
!
!..... Process comma or close bracket found within bracketed construct
!
3160   continue
       if (state .eq. 2) then
         state = 0
         if (c.eq.',') then
           index_ = index_+1
           indexstack(depth_) = index_
           delimstack(depth_+1) = c
           posdlmstk(depth_+1) = ip
           recdlmstk(depth_+1) = irecd
           goto 3100
         endif
       endif
       depth_ = depth_-1
!DBG   print *,' decreasing depth ',depth_, recn_, 
!DBG *  buffer(jchar:lastch)

       type_='null'
       long_ = 1
       strg_(1:long_) = ' '
       if (depth_ .eq.0 ) goto 500
       state = 2
       statestack(depth_) = 2
       delimstack(depth_+1) = c
       posdlmstk(depth_+1) = ip
       recdlmstk(depth_+1) = irecd
       go to 500
!
!..... Process colon found within bracketed construct
!      treat as a comma if already started
!
3380   continue
       if (state .eq. 2) then
         state = 0
         index_ = index_+1
         indexstack(depth_) = index_
         delimstack(depth_) = c
         posdlmstk(depth_+1) = ip
         recdlmstk(depth_+1) = irecd
         goto 3100
       endif
       type_='null'
       long_ = 1
       strg_(1:long_) = ' '
       state = 2
       statestack(depth_) = 2
       delimstack(depth_) = c
       go to 500


!
!..... Span blank delimited token; test if a number or a character
!
3200   type_='numb'
       im=0
       innerdepth = depth_
       do 3205 i=1,11
3205     jj(i)=0
       ip = jchar
       do 3250 i=jchar,lastch
       ip = i
       if((buffer(i:i).eq.'('.and.rdprn_)                               &
     &   .or.(buffer(i:i).eq.'{'.and.rdbrc_)                            &
     &   .or.(buffer(i:i).eq.'['.and.rdbkt_)) then
         if (depth_ .ge. MAXDEPTH) then
           call tbxxerr(' Stack overflow, increase MAXDEPTH')
         end if
         depth_=depth_+1
!DBG   print *,' increasing depth ',depth_, recn_, 
!DBG *   buffer(jchar:lastch)
         typestack(depth_) = type_
         indexstack(depth_) = 1
         brackstack(depth_) = buffer(i:i)
       endif
       if((buffer(i:i).eq.')'.and.brackstack(depth_).eq.'(')            &
     &   .or.(buffer(i:i).eq.'}'.and.brackstack(depth_).eq.'{')         &
     &   .or.(buffer(i:i).eq.']'.and.brackstack(depth_).eq.'[')         &
     &   .or.(buffer(i:i).eq.' '.and.brackstack(depth_).eq.' ')) then
         if (depth_.gt.innerdepth) then
           depth_=innerdepth
           call tbxxwarn(                                               &
     & ' Failed to balance brackets in blank-delimited token')
!DBG   print *,' decreasing depth ',depth_, recn_, 
!DBG *  buffer(jchar:lastch)
         else
           go to 3395
         endif
       endif
       if(buffer(i:i).eq.' ')       goto 3400
       if(buffer(i:i).eq.tab)       goto 3400
       if(buffer(i:i).eq.',')       goto 3390
       if(buffer(i:i).eq.':'.and.rdcolon_) go to 3390
       if(buffer(i:i).eq.brackstack(depth_)) goto 3400
       if(type_.ne.'numb')          goto 3250
       j=index(num,buffer(i:i))
       if(j.eq.0)                 type_='char'
       if(j.le.10) then
         im=im+1
         goto 3250
       endif
       if(j.gt.13.and.im.eq.0) type_='char'
       jj(j-10)=jj(j-10)+1
3250   continue
       i=lastch+1
       ip = i
       if(type_.ne.'numb') goto 3400
       do 3270 j=1,5
         if((jj(j).gt.1.and.j.gt.2) .or.                                &
     &     jj(j).gt.2)             type_='char'
3270   continue
       go to 3400

!
!..... Span '\'' or '\"' quote delimited token; assume character
!
3300   type_='char'
       quoted=.true.
       jchar=jchar+1

       if (rdtq_ .and. jchar+1 .le. lastch                              &
     &   .and. buffer(jchar:jchar+1).eq.c//c) then
         quote_ = c//c//c
         jchar = jchar+2
         if (tbxxtttq(jtloc)) then
           text_=.false.
         else
           jtloc = lastch
           text_=.true.
           type_='text'
         endif
         long_ = jtloc-jchar
         if (long_.eq.0) then
           strg_=' '
         else
           strg_(1:long_)=buffer(jchar:jtloc)
         endif
         goto 500
       end if

       escaped = .false.
      
!DBG   print *,'Processing quoted string '
!DBG   print *,buffer(jchar:lastch)

       ip = jchar
       do 3320 i=jchar,lastch
         ip = i
         if (.not.escaped.and.rdrcqt_) then
           if (c.eq.slash) then
             escaped = .true.
             go to 3320
           end if
         end if
         if (escaped) then
           escaped = .false.
           go to 3320
         end if
!DBG     print *,'i,c,buffer(i:i)',i,c,buffer(i:i) 

         if(rdrcqt_)                      goto 3400
         if(buffer(i:i).ne.c)             goto 3320
         if(i+1.gt.lastch)                goto 3400
         if (tbxxtsts(buffer(i+1:i+1)))   goto 3400
3320    continue
       go to 3400
!.....  Span (-delimited tuple
3350    type_ = 'tupl'
       go to 3375
!.....  Span [-delimited list or array
3360    type_ = 'list'
       go to 3375
!.....  Span { delimited table
3370    type_ = 'tabl'
        if (.not. rdbkt_) type_='list'
3375    continue
       if (depth_ .ge. MAXDEPTH) then
         call tbxxerr(' Stack overflow, increase MAXDEPTH')
       end if
       depth_=depth_+1
!DBG   print *,' increasing depth ',depth_, recn_, 
!DBG *  buffer(jchar:lastch)
       typestack(depth_) = type_
       indexstack(depth_) = 1
       brackstack(depth_) = buffer(ip:ip)
       state = 0
       statestack(depth_) = state
       go to 3100


3390    if(depth_ .ne. innerdepth) then
         call tbxxwarn(' failed to close bracketed string')
         depth_ = innerdepth
        endif
        go to 3400


3395   ip = ip-1

3400   state = 2
       statestack(depth_) = state
       go to 400

3500   type_='fini'
       dictype_=type_
       diccat_='(none)'
       dicname_=' '
       if (depth_ .gt.0) then
         call tbxxwarn(                                                 &
     &     ' File ended in unterminated bracketed construct')
         depth_ = 0
       endif
       go to 500



!
!..... Store the string for the getter
!
400    long_=0
       strg_=' '
         if(ip.gt.jchar) then
         long_=ip-jchar
         strg_(1:long_)=buffer(jchar:ip-1)
       endif
       jchar=ip
       quote_=' '
       if(quoted) then
         quote_=buffer(jchar:jchar)
         if (depth_.eq.0) jchar =jchar+1
       endif
       if(type_.ne.'char'.or.quoted.or.depth_.gt.0) goto 500
       if(strg_(1:5).eq.'data_') then
          type_='data'
          depth_=0
       end if
       if(strg_(1:5).eq.'loop_') then
         type_='loop'
         depth_=0
       end if
!DBG   if (strg_(1:max(1,long_)).eq.'?') print *,long_,strg_(1:1)
       if(long_.eq.1.and.strg_(1:1).eq.'?') type_='null'
       if(long_.eq.1.and.strg_(1:1).eq.'.') type_='null'
       if(strg_(1:5).eq.'save_') then
         type_='save'
         depth_=0
       end if
       if(long_.eq.7.and. strg_(1:7).eq.'global_') then
         type_='glob'
         depth_=0
       end if
!
500    continue
!DBG   print *,' leaving getstr with strg: ', strg_(1:long_)
!DBG   print *,' leaving getstr type, text_, quote_, depth_, jchar: '
!DBG   print *, type_,', ',text_,', ',quote_,', ',depth_,', ',jchar
       return
       end
!
!
!
!
!
!
! >>>>>> Convert a character string into a number and its esd
!
!                                          Q
!                                          D+
!                                          E-
!                                +         +
!           number string        -xxxx.xxxx-xxx(x)
!           component count CCNT 11111222223333444
!           (with at least 1 digit in the mantissa)
!
         subroutine ctonum
!
         integer   lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character test*26,c*1
         integer*4 m,nchar
         integer*4 ccnt,expn,msin,esin,ndec,ids,nmd
         integer*4 nms,ned,nef,nes
         double precision numb,sdev,ntemp,mant
         data test /'0123456789+.-()EDQedq :,]}'/
!
         numbtb=0.D0
         sdevtb=-1.D0
         numb=1.D0
         sdev=0.D0
         ccnt=0
         mant=0.D0
         expn=0.
         msin=+1
         esin=+1
         ndec=0
         ids=0
         nmd=0
         nms=0
         ned=0
         nef=0
         nes=0
         type_='char'
         posdec_=0
         esddig_=0
         if(long_.eq.1.and.                                             &
     &     index('0123456789',strg_(1:1)).eq.0) goto 500
         lzero_=.false.
         decp_=.false.
!
!....... Loop over the string and identify components
!
!        The scan works in phases
!          ccnt = 0   processing looking for first digit
!          ccnt = 1   processing before decimal point
!          ccnt = 2   processing after decimal point
!          ccnt = 3   processing exponent
!          ccnt = 4   processing standard deviation
!
         do 400 nchar=1,long_
!
         c=strg_(nchar:nchar)
         m=index(test,c)
         if(m.eq.0)     goto 500
         if(m.gt.10)    goto 300
!
!....... Process the digits
!
         if(ccnt.eq.0)  ccnt=1
         if(ccnt.eq.2)  ndec=ndec+1
         if(ccnt.gt.2)  goto 220
         ntemp=m-1
         if (ndec.eq.0) then
           mant=mant*10.D0+ntemp
         else
           mant=mant+ntemp/10.D0**(ndec)
         endif
         nmd=nmd+1
         if(ccnt.eq.1.and.mant.ne.0.D0) ids=ids+1
         goto 400
220      if(ccnt.gt.3)  goto 240
         expn=expn*10+m-1
         goto 400
240      esddig_=esddig_+1
         ntemp=m-1
         sdev=sdev*10.D0+ntemp
         sdevtb=1.D0
         goto 400
!
!....... Process the characters    . + - ( ) E D Q
!
300      if(c.ne.'.')  goto 320
         decp_=.true.
         if(nchar.gt.1.and.mant.eq.0.d0) then
           if(strg_(nchar-1:nchar-1).eq.'0') lzero_=.true.
         endif
         if(ccnt.gt.1) goto 500
         posdec_=nchar
         ccnt=2
         goto 400
!
320      if(nmd.eq.0.and.m.gt.13) goto 500
         if(c.ne.'(')  goto 340
         if(posdec_.eq.0) posdec_=nchar
         ccnt=4
         goto 400
!
340      if(posdec_.eq.0.and.ccnt.gt.0) posdec_=nchar
         if(c.eq.')' .or. c.eq.' ')  goto 400
         if(ccnt.eq.3 .and. ned.gt.0) goto 500
         if(m.gt.13) then
           if (nef.gt.0) goto 500
           nef = nef+1
           ccnt = 3
           esin = 1
         else
           if(ccnt.gt.0) then
             if (nes.gt.0) goto 500
             nes = nes+1
             ccnt = 3
             esin = 12-m
           else
             if (nms.gt.0) goto 500
             nms = nms+1
             ccnt=1
             msin=12-m
           endif
         endif
!
400      continue
!
         if(posdec_.eq.0) posdec_=lastnb(strg_(1:long_))+1
!
!....... String parsed; construct the numbers
!
         expn=expn*esin
         if(expn+ids.gt.-minexp) then
           call tbxxwarn(' Exponent overflow in numeric input')
           expn=-minexp-ids
         endif
         if(expn.lt.minexp) then
           call tbxxwarn(' Exponent underflow in numeric input')
           expn=minexp
         endif
         if(expn-ndec.lt.0) numb=1./10.D0**abs(expn-ndec)
         if(expn-ndec.gt.0) numb=10.D0**(expn-ndec)
         if(sdevtb.gt.0.0) sdevtb=numb*sdev
         numb=1.D0
         if(expn.lt.0) numb=1./10.D0**abs(expn)
         if(expn.gt.0) numb=10.D0**(expn)
         ntemp=msin
         numbtb=numb*mant*ntemp
         type_='numb'
!
500      return
         end
!
!
!
!
!
!
! >>>>>> Read a new line from the direct access file
!
         subroutine getlin(flag)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character flag*4
         integer   kpp,lpp,mpp,npp,ir
         integer   tbxxrld
         integer   lip,mp,kip,ip,mip,mis
         integer   icpos,itpos,ixpos,ixtpos
!
         irecd=irecd+1
         jchar=1
         kpp = 0
         if(irecd.eq.jrecd.and.                                         &
     &     irecd.gt.recbeg_.and.                                        &
     &     irecd.le.recend_)  goto 200
         if(irecd.le.min(lrecd,recend_))  goto 100
         irecd=min(lrecd,recend_)+1
         buffer(1:1)=' '
         lastch=0
         jchar=MAXBUF+1
         jrecd=-1
         flag='fini'
         goto 200
100      continue
         lpp=-1
         mpp=-1
         npp=kpp
         call tbxxflin(irecd,lip,kpp,mp,kip,ip,mip,mis)
         if (lip.eq.0) then
           buffer(1:1) = ' '
           lastch = 1
           go to 130
         endif
         do ir = 1,NUMPAGE
           if(iabs(mppoint(ir)).eq.kpp) then
             lpp = ir
             goto 120
           endif
           if(mppoint(ir).eq.0) then
             lpp=ir
           else
             if(iabs(iabs(mppoint(ir))-kpp)                             &
     &         .gt.iabs(npp-kpp)) then
               mpp=ir
               npp=iabs(mppoint(ir))
             endif
           endif
         enddo
!
!        failed to find page as resident
!        remove a target page
!
         if(lpp.eq.-1)lpp=mpp
         if(lpp.eq.-1)lpp=1
         if (mppoint(lpp).lt.0) then
           write(dirdev,'(a)',rec=-mppoint(lpp)) pagebuf(lpp)
         endif
         mppoint(lpp)=kpp
         read(dirdev,'(a)',rec=kpp) pagebuf(lpp)
120      lastch = tbxxrld(buffer,pagebuf(lpp)(mp:NUMCPP), .false.)
130      recn_=irecd
         jrecd=irecd
         flag=' '
         if (lastch.gt.0 .and. tabx_) then
           icpos=1
           itpos=1

140        ixpos=index(buffer(icpos:lastch),tab)
           ixtpos=ixpos+itpos-1
           if(ixpos.gt.0.and.ixtpos.le.MAXBUF) then
             ixtpos=((ixtpos+7)/8)*8
             if(ixpos.gt.1) then
               bufntb(itpos:ixtpos)=                                    &
     &           buffer(icpos:ixpos+icpos-2)
             else
             bufntb(itpos:ixtpos)=' '
             endif
             itpos=ixtpos+1
             icpos=ixpos+icpos
             goto 140
           else
             bufntb(itpos:min(MAXBUF,itpos+lastch-icpos))=              &
     &         buffer(icpos:lastch)
           endif
           buffer(1:min(MAXBUF,itpos+lastch-icpos))=                    &
     &        bufntb(1:min(MAXBUF,itpos+lastch-icpos))
           lastch = min(MAXBUF,itpos+lastch-icpos)
         endif
200      return
         end
!
!
!
!
!
!
! >>>>>> Write error message and exit.
!
         subroutine tbxxerr(mess)
         character*(*) mess
         call tbxxcmsg('error',mess)
         stop
         end
!
!
!
!
!
!
! >>>>>> Write warning message and continue.
!
         subroutine tbxxwarn(mess)
         character*(*) mess
         call tbxxcmsg('warning',mess)
         return
         end
!
!
!
!
!
!
! >>>>>> Write a message to the error device
!
         subroutine tbxxcmsg(flag,mess)
!
         integer    lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character*(*) flag
         character*(*) mess
         character*(MAXBUF)  tline
         character*5   btype
         integer       ll,ls,ltry,ii,i
!
         btype = 'data_'
         if(save_) btype = 'save_'
         if(.not.glob_) then
         tline= ' ciftbx '//flag//': '                                  &
     &   //file_(1:longf_)//' '//btype                                  &
     &   //bloc_(1:max(1,lastnb(bloc_)))//' line:'
         else
         tline= ' ciftbx '//flag//': '                                  &
     &   //file_(1:longf_)//' global_'//' line:'
         endif
         ll = max(1,lastnb(tline))
         write(errdev,'(a,i7)')tline(1:ll),irecd
         ll=len(mess)
         ls=1
100      if(ll-ls.le.79) then
           write(errdev,'(1X,a)') mess(ls:ll)
           return
         else
           ltry = min(ll,ls+79)
           do ii = ls+1,ltry
           i = ltry-ii+ls+1
           if(mess(i:i).eq.' ') then
             write(errdev,'(1X,a)') mess(ls:i-1)
             ls=i+1
             if(ls.le.ll) go to 100
             return
           endif
           enddo
           write(errdev,'(1X,a)') mess(ls:ltry)
           ls=ltry+1
           if(ls.le.ll) go to 100
           return
         endif
         end
!
!
!
!
! >>>>>> Create a named file.
!
         function pfile_(fname)
!
         logical   pfile_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical   test
         integer   lfname
         integer   i
         character fname*(*)
!
!....... Test if a file by this name is already open.
!
         if(pfilef.eq.'yes') call close_
         pfilef='no '
         file_(1:longf_) = ' '
         lfname = len(fname)
         file_(1:lfname)=fname
         do 120 i=1,lfname
         if(file_(i:i).eq.' ') goto 140
120      continue
         i = lfname+1
140      if (i.gt.1) then
           inquire(file=file_(1:i-1),exist=test)
           pfile_=.false.
           longf_ = i-1
           if(test)            goto 200
         else
           file_ = ' '
           pfile_ = .true.
           longf_ = 1
         endif
!
!....... Open up a new CIF
!
         if (file_(1:1) .ne. ' ')  then
         open(unit=outdev,file=file_(1:longf_),status='NEW',            &
     &                    access='SEQUENTIAL',                          &
     &                    form='FORMATTED')
         precn_=0
         endif
         pfile_=.true.
         pfilef='yes'
         nbloc=0
         pchar=1+lprefx
         pcharl=0
         obuf=prefx
         obuf(pchar:MAXBUF)=' '
200      ploopn = 0
         ploopc = 0
         ploopf = 'no '
         ptextf = 'no '
         pdepth_ = 0
         pdelimstack(1) = ' '
         pposdlmstk(1) = 0
         plcat = ' '
         pdblok = ' '
         plhead(1) = ' '
         if (xmlout_) then
           call tbxxpstr('<?xml version="1.0"?>')
         endif
         return
         end


!
!
!
!
!
! <<<<<< Substitute item in data block XML translation
!
         function tbxxxsub(oblok,xstring)
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character   oblok*(*)
         character   xstring*(*)
         character   tbxxxsub*(MAXBUF)
         integer     ii, jj, kk
         integer     lastnb
         jj = 1
         tbxxxsub = ' '
         do ii = 1,lastnb(xstring)
           if(xstring(ii:ii).ne.'%') then
             tbxxxsub(jj:jj) = xstring(ii:ii)
             jj = jj+1
           else
             do kk = 1,lastnb(oblok)
               tbxxxsub(jj:jj) = oblok(kk:kk)
               jj = jj+1
             enddo
           endif
         enddo
         return
         end

!
!
!
!
!
! >>>>>> Store a data block command in the CIF
!        Call with blank name to close current block only
!
         function pdata_(name)
!
         logical   pdata_
         SAVE
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character name*(*),temp*(MAXBUF)
         character dbloc(100)*(NUMCHAR)
         character tbxxxsub*(MAXBUF)
         integer   i
         integer   lastnb
!
         pdata_=.true.
         if(ptextf.eq.'yes') call tbxxeot
         if(pdepth_ .gt.0)   call tbxxebkt
         if(ploopn.ne.0)     call tbxxelp

         if(psaveo) then
           pchar=-1
           if(pposval_.ne.0) then
             pchar=lprefx+1
             call tbxxpstr(' ')
             pchar=lprefx+pposval_
             pposval_=0
           endif
           if (xmlout_) then
             call tbxxpxct('save_',' ')
           else
             call tbxxpstr('save_')
           endif
           psaveo=.false.
         endif
         if (pdblok(1:1).ne.' ') then
           if (xmlout_) then
             if (xmdata.eq.0) then
               call tbxxpxct(pdblok,' ')
             else
               call tbxxpxct(tbxxxsub(pdblok,xmlate(xmdata)),' ')
             endif
           endif
           pdblok=' '
         endif
         if(globo_) then
           pchar=-1
           temp='global_'
           pdblok='global_'
           psaveo=.false.
           goto 135
         endif
!
!....... Check for duplicate data name
!
         temp=name
         if(temp.eq.' ')        goto 200
         if(saveo_)             goto 130
         pdata_=.false.
         do 110 i=1,nbloc
         if(temp.eq.dbloc(i))   goto 130
110      continue
         pdata_ = .true.
         goto 125
!
!....... Save block name and put data_ statement
!
125      nbloc=nbloc+1
         if(nbloc.le.100) dbloc(nbloc)=temp(1:min(NUMCHAR,MAXBUF))
         pdblok = temp(1:min(NUMCHAR,MAXBUF))
130      pchar=-1
         temp='data_'//name
         if(saveo_) temp='save_'//name
         if(globo_) temp='global_'
         psaveo=saveo_
135      if(pposnam_.gt.0) then
           pchar=lprefx+1
           call tbxxpstr(' ')
           pchar=lprefx+pposnam_
           pposnam_=0
         endif
         if (xmlout_) then
           if (globo_) then
             call tbxxpxot('global_',' ')
           else
             if (xmdata.eq.0) then
               call tbxxpxot(pdblok,' ')
             else
               call tbxxpxot(tbxxxsub(pdblok,xmlate(xmdata)),' ')
             endif
             if (saveo_) then
               call tbxxpxot('save_',' ')
             endif
           endif
         else
           call tbxxpstr(temp(1:lastnb(temp)))
         endif
         pchar=lprefx
         plcat = ' '
         ploopn = 0
!
200      return
         end

!
!
!
!
!
!
! >>>>>> Process a name to extract the category and item
!
         subroutine tbxxgcat(name,type,flag,tflag,mycat,myxcat,         &
     &     item,xitem,nroot)
!
         character  name*(*),mycat*(*),item*(*),nroot*(*),type*4
         character  myxcat*(*),xitem*(*)
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  xxxtemp*(NUMCHAR)
         logical    flag,tflag
         integer    lastnb,kpl,npl
         character  str1*(NUMCHAR), str2*(NUMCHAR)
         integer    kdc, lmycat


         item  = name
         xitem = ' '
         nroot = name
         mycat = ' '
         myxcat = ' '
         flag = .true.
         tflag = .true.
         if(vcheck.eq.'yes') then
           kdc = 0
           call tbxxdck(name,type,flag,tflag)
           if (xdchk.ne.0) then
             kdc = dcindex(xdchk)
             if (xmindex(xdchk).ne.0) xitem = xmlate(xmindex(xdchk))
           endif
           if (aliaso_.and.xdchk.ne.0) then
             if (aroot(xdchk).ne.0) then
               nroot = dictag(aroot(xdchk))
               kdc = dcindex(aroot(xdchk))
             endif
           endif
           if (kdc.ne.0) then
             mycat = dcname(kdc)
             myxcat = ' '
             if (xmcind(kdc).ne.0) myxcat = xmlate(xmcind(kdc))
           endif
         else
           call tbxxcat(name,mycat,lmycat)
         endif
         kpl = lastnb(mycat)
         npl = lastnb(name)
         call tbxxnlc(str1, mycat)
         call tbxxnlc(str2, name)
         if (mycat(1:1).ne.' ' .and. name(1:1).eq.'_') then
           if(str1(1:kpl).eq.str2(2:kpl+1) .and. npl .gt. kpl+2 .and.   &
     &       (name(kpl+2:kpl+2).eq.'.' .or.                             &
     &       name(kpl+2:kpl+2).eq.'_') ) then
             item = name(kpl+3:npl)
           else
             item = name(2:npl)
           endif
         else
           if (mycat(1:1).eq.' ' .and. plcat(1:1).ne.' '                &
     &       .and. name(1:1).eq.'_') then
             call tbxxnlc(str1, plcat)
             kpl = lastnb(plcat)
             if(str1(1:kpl).eq.str2(2:kpl+1) .and. npl .gt. kpl+2 .and. &
     &         (name(kpl+2:kpl+2).eq.'.' .or.                           &
     &         name(kpl+2:kpl+2).eq.'_') ) then
               mycat = plcat
               item = name(kpl+3:npl)
             else
               item = name(2:npl)
             endif
           else
             item = name
             if (item(1:1).eq.'_') item = name(2:npl)
           endif
         endif
         if (xmlong_) then
           item = name
           if (item(1:1).eq.'_') item = name(2:npl)
         endif
         call tbxxnupc(xxxtemp,mycat)
         mycat = xxxtemp
         return
         end

!
!
!
!
!
!
! >>>>>> Put a number into the CIF, perhaps with an esd appended
!
         function pnumb_(name,numb,sdev)
!
         logical    pnumb_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical    flag,tflag
         character  name*(*),temp*(NUMCHAR)
         character  mycat*(NUMCHAR),item*(NUMCHAR)
         character  myxcat*(XMLCHAR),xitem*(XMLCHAR)
         real       numb,sdev
         double precision dnumb,dsdev,dprec
         integer    kmn
         integer    lastnb
!
         pnumb_=.true.
         flag  =.true.
         tflag =.true.
         temp=name
         if(ptextf.eq.'yes') call tbxxeot
         if (pdepth_ .gt.0.and.name(1:1).ne.char(0))                    &
     &     call tbxxebkt
!
         if(name(1:1).eq.' '.or.name(1:1).eq.char(0))                   &
     &     goto 110
         call tbxxgcat(name,'numb',flag,tflag,mycat,myxcat,             &
     &     item,xitem,temp)
         pnumb_=flag
         if(ploopn.ne.0)        call tbxxelp
         if (xmlout_) then
           if (plcat(1:1).ne.' ' .and. plcat.ne.mycat) then
             call tbxxpxct(plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             call tbxxpxct(plcat,plxcat)
             plcat = ' '
             plxcat = ' '
           endif
         endif
         pchar=-1
         if(pposnam_.ne.0)pchar=pposnam_+lprefx
         if (xmlout_) then
           if ((plhead(1)(1:1).ne.' '.and.plhead(1).ne.item)            &
     &       .or. plcat.ne.mycat) then
             call tbxxpxct (plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             if (plcat.ne.mycat) then
               call tbxxpxct(plcat,plxcat)
               plcat = mycat
               plxcat = myxcat
               call tbxxpxot(plcat,plxcat)
             endif
             call tbxxpxot (item,xitem)
           else
             if(plhead(1)(1:1).eq.' ') call tbxxpxot (item,xitem)
           endif
           plhead(1) = item
           plxhead(1) = xitem
         else
           call tbxxpstr(temp(1:lastnb(temp)))
         endif
         go to 120
!
110      if (xmlout_) then
           if (ploopn.gt.0) then
             kmn = mod(ploopc,ploopn)+2
             if (ploopn.gt.1.or.ploopf.eq.'yes') then
               call tbxxpxot(plhead(kmn),plxhead(kmn))
             endif
           endif
         endif
!
120      if(ploopf.eq.'yes') ploopc=0
         ploopf='no '
         dprec=decprc
         dnumb=numb
         dsdev=sdev
         call tbxxpnum(dnumb,dsdev,dprec)
         if(.not.flag) then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not in dictionary -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not in dictionary')
             call tbxxpstr(char(0))
           endif
         endif
         if(.not.tflag) then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not correct type -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not correct type')
             call tbxxpstr(char(0))
           endif
         endif
         if (xmlout_) then
           if (ploopn.gt.1 .and.ploopc.gt.0) then
             call tbxxpxct(plhead(ploopc+1),plxhead(ploopc+1))
           endif
         endif
!
         pposnam_=0
         pposval_=0
         pposdec_=0
         pposend_=0
         pesddig_=0
         return
         end
!
!
!
!
!
!
! >>>>>> Put a double precision number into the CIF, perhaps
!        with an esd appended
!
         function pnumd_(name,numb,sdev)
!
         logical    pnumd_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical    flag,tflag
         character  name*(*),temp*(NUMCHAR)
         character  mycat*(NUMCHAR),item*(NUMCHAR)
         character  myxcat*(XMLCHAR),xitem*(XMLCHAR)
         double precision numb,sdev
         integer    kmn
         integer    lastnb
!
         pnumd_=.true.
         flag  =.true.
         tflag =.true.
         temp=name
         if(ptextf.eq.'yes') call tbxxeot
         if (pdepth_ .gt.0.and.name(1:1).ne.char(0))                    &
     &      call tbxxebkt
!
         if(name(1:1).eq.' '.or.name(1:1).eq.char(0))                   &
     &      goto 110
         call tbxxgcat(name,'numb',flag,tflag,mycat,myxcat,             &
     &     item,xitem,temp)
         pnumd_=flag
         if(ploopn.ne.0)        call tbxxelp
         if (xmlout_) then
           if (plcat(1:1).ne.' ' .and. plcat.ne.mycat) then
             call tbxxpxct(plhead(1),plxhead(1))
             plhead(1) = ' '
             call tbxxpxct(plcat,plxcat)
             plcat = ' '
             plxcat = ' '
           endif
         endif
         pchar=-1
         if(pposnam_.ne.0)pchar=pposnam_+lprefx
         if (xmlout_) then
           if ((plhead(1)(1:1).ne.' '.and.plhead(1).ne.item)            &
     &       .or. plcat.ne.mycat) then
             call tbxxpxct (plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             if (plcat.ne.mycat) then
               call tbxxpxct(plcat,plxcat)
               plcat = mycat
               plxcat = myxcat
               call tbxxpxot(plcat,myxcat)
             endif
             call tbxxpxot (item,xitem)
           else
             if(plhead(1)(1:1).eq.' ') call tbxxpxot (item,xitem)
           endif
           plhead(1) = item
           plxhead(1) = xitem
         else
           call tbxxpstr(temp(1:lastnb(temp)))
         endif
         go to 120
!
110      if (xmlout_) then
           if (ploopn.gt.0) then
             kmn = mod(ploopc,ploopn)+2
             if (ploopn.gt.1.or.ploopf.eq.'yes') then
               call tbxxpxot(plhead(kmn),plxhead(kmn))
             endif
           endif
         endif
!
120      if(ploopf.eq.'yes') ploopc=0
         ploopf='no '
         call tbxxpnum(numb,sdev,dpprc)
         if(.not.flag) then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not in dictionary -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not in dictionary')
             call tbxxpstr(char(0))
           endif
         endif
         if(.not.tflag) then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not correct type -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not correct type')
             call tbxxpstr(char(0))
           endif
         endif
         if (xmlout_) then
           if (ploopn.gt.1 .and.ploopc.gt.0) then
             call tbxxpxct(plhead(ploopc+1),plxhead(ploopc+1))
           endif
         endif
!
         pposnam_=0
         pposval_=0
         pposdec_=0
         pposend_=0
         pesddig_=0
         return
         end
!
!
!
!
!
!
! >>>>>> Put a character string into the CIF.
!
         function pchar_(name,string)
!
         logical    pchar_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical    flag,tflag
         logical    pdelim_
         character  name*(*),temp*(NUMCHAR),string*(*)
         character  mycat*(NUMCHAR),item*(NUMCHAR)
         character  myxcat*(XMLCHAR),xitem*(XMLCHAR)
         character  line*(MAXBUF),strg*(MAXBUF)
         character*3 tsq,tdq,pqt
         integer    i, j, kfold, pql
         integer    lstring
         integer    lastnb
         integer    kmn, ic
         character*1 slash
!
         slash = rsolidus(1:1)
         pchar_=.true.
         flag  =.true.
         tflag =.true.
         tsq = ''''''''
         tdq = '"""'
         temp  =name
         lstring = lastnb(string)
         if (lstring .gt. MAXBUF) then
           call tbxxwarn(                                               &
     &       'Output CIF line longer than MAXBUF, truncated')
           lstring = MAXBUF
         endif
         pqt = pquote_
         pql = lastnb(pqt)
         if(ptextf.eq.'yes') call tbxxeot
         if(pdepth_ .gt.0.and.name(1:1).ne.char(0))                     &
     &     call tbxxebkt
!
         if(name(1:1).eq.' '.or.name(1:1).eq.char(0))                   &
     &     goto 110
         call tbxxgcat(name,'char',flag,tflag,mycat,myxcat,             &
     &     item,xitem,temp)
         pchar_=flag
         if(ploopn.ne.0)        call tbxxelp
         if (xmlout_) then
           if (plcat(1:1).ne.' ' .and. plcat.ne.mycat) then
             call tbxxpxct(plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             call tbxxpxct(plcat,plxcat)
             plcat = ' '
             plxcat = ' '
           endif
         endif
         pchar=-1
         if(pposnam_.gt.0) pchar=posnam_+lprefx
         if (xmlout_) then
           if ((plhead(1)(1:1).ne.' '.and.plhead(1).ne.item)            &
     &       .or. plcat.ne.mycat) then
             call tbxxpxct (plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             if (plcat.ne.mycat) then
               call tbxxpxct(plcat,plxcat)
               plcat = mycat
               plxcat = myxcat
               call tbxxpxot(plcat,plxcat)
             endif
             call tbxxpxot (item,xitem)
           else
             if(plhead(1)(1:1).eq.' ') call tbxxpxot (item,xitem)
           endif
           plhead(1) = item
           plxhead(1) = xitem
         else
           call tbxxpstr(temp(1:lastnb(temp)))
         endif
         go to 120
!
110      if (xmlout_) then
           if (ploopn.gt.0) then
             kmn = mod(ploopc,ploopn)+2
             if (ploopn.gt.1.or.ploopf.eq.'yes') then
               call tbxxpxot(plhead(kmn),plxhead(kmn))
             endif
           endif
         endif
!
120      if(ploopf.eq.'yes') ploopc=0
         ploopf='no '
         i=1
         if (string(1:1).eq.char(0)) go to 210
         if (xmlout_) then
           do ic = 1,lstring
            if ( string(ic:ic).eq.'&'                                   &
     &        .or. string(ic:ic).eq.'<'                                 &
     &        .or. string(ic:ic).eq.'>' ) then
              if(i.lt.MAXBUF) then
                line(i:i) = '&'
              endif
              if (i.lt.MAXBUF) then
                if( string(ic:ic).eq.'&' ) then
                  line(i:MAXBUF)='amp;'
                  i = i+4
                endif
                if( string(ic:ic).eq.'<' ) then
                  line(i:MAXBUF)='lt;'
                  i = i+3
                endif
                if( string(ic:ic).eq.'>' ) then
                  line(i:MAXBUF)='gt;'
                  i = i+3
                endif
              endif
              if (i.gt.MAXBUF+1) then
                i = MAXBUF+1
              endif
            else
              if(i.lt.MAXBUF) then
                line(i:i) = string(ic:ic)
                i = i+1
              endif
            endif
           enddo
           if (i.gt.1) i = i-1
           if (i.lt.MAXBUF) line(i+1:MAXBUF) = ' '
         else
           line=string
           i = lstring
         endif
         if(pposval_.ne.0.and.pposend_.ge.pposval_)                     &
     &      i=max(i,pposend_-pposval_+1)
         if(pfold_ .ne. 0 .and. lstring .gt. min(pfold_,line_) )        &
     &      go to 290
         if (i .gt. MAXBUF) then
           call tbxxwarn(                                               &
     &       'Output CIF line longer than MAXBUF, truncated')
           i = MAXBUF
         endif
         if(pquote_.ne.' ')   go to 150
         do 140 j=i,1,-1
         if(line(j:j).eq.' ') go to 150
140      continue
         if((line(1:1).eq.'_'                                           &
     &     .or. line(i:i).eq.'_'                                        &
     &     .or. line(1:1).eq.''''                                       &
     &     .or. line(1:1).eq.'"'                                        &
     &     .or. line(1:1).eq.';'                                        &
     &     .or. line(1:1).eq.'('                                        &
     &     .or. line(1:1).eq.'['                                        &
     &     .or. line(1:1).eq.'(')                                       &
     &     .and.line(1:i).ne.'''.'''                                    &
     &     .and.line(1:i).ne.'''?'''                                    &
     &     .and.line(1:i).ne.'"."'                                      &
     &     .and.line(1:i).ne.'"?"') go to 150
         strg=line(1:i)
         goto 200
150      if(pqt.eq.';'                                                  &
     &     .or. pqt.eq. tsq                                             &
     &     .or. pqt.eq. tdq                                             &
     &     .or. pqt.eq. '('                                             &
     &     .or. pqt.eq. '{'                                             &
     &     .or. pqt.eq. '[')       go to 190
         if(line(1:i).eq.' '.and.nblanko_) then
           strg = '.'
           i = 1
           if(pposval_.ne.0) then
             pchar=pposval_+lprefx
           endif
           call tbxxpstr(strg(1:i))
           go to 210
         endif
         if(pqt.eq.'"' .or. pqt.eq.'"""')       go to 170
         do 160 j=1,i-1
         if(line(j:j).eq.''''.and.                                      &
     &     (line(j+1:j+1).eq.' '.or.line(j+1:j+1).eq.tab))              &
     &     goto 170
160      continue
         strg=''''//line(1:i)//''''
         i=i+2
         pqt = ''''
         pql = 1
         goto 200
170      do 180 j=1,i-1
         if(line(j:j).eq.'"'.and.                                       &
     &     (line(j+1:j+1).eq.' '.or.line(j+1:j+1).eq.tab))              &
     &     goto 190
180      continue
         strg='"'//line(1:i)//'"'
         i=i+2
         pqt = '"'
         pql = 1
         if(pfold_ .gt. 1 .and. i .gt. min(pfold_,line_) ) go to 290
         goto 200
190      pchar=-1
         if (xmlout_) then
           if (pqt.eq.';') then
           strg = '<![CDATA['//line(1:i)
           i = i+9
         else
             strg = pqt(1:pql)//'<![CDATA['//line(1:i)
             i = i+9+pql
           endif
         else
           if (pclipt_ .and. pqt.eq.';' .and. line(1:1).eq.' ') then
             strg =pqt(1:pql)//line(2:i)
             i = i-1+pql
           else
             strg =pqt(1:pql)//line(1:i)
             i = i+pql
           endif
         endif
         ptextf='yes'
         call tbxxpstr(strg(1:i))
         pchar=-1
         ptextf='no '
         if (pqt.eq.'('                                                 &
     &     .or.pqt.eq.'{'                                               &
     &     .or.pqt.eq.'[') then
           if (pqt.eq.'(') call tbxxpstr(')')
           if (pqt.eq.'{') call tbxxpstr('}')
           if (pqt.eq.'[') call tbxxpstr(']')
         else
           call tbxxpstr(pqt(1:pql))
         endif
         if (xmlout_) then
           call tbxxpstr(']]>')
         endif
         pchar=lprefx
         call tbxxpstr(' ')
         strg =                                                         &
     &    ' Converted pchar_ output to text for: '//string(1:lstring)
         call tbxxwarn(strg)
         goto 210
!
200      if(pposval_.ne.0) then
           pchar=pposval_+lprefx
           if(pqt.ne.' ') pchar=pchar-pql
         endif
         if (pdepth_.gt.0) then
           if(pstatestack(pdepth_).eq.2)                                &
     &     tbxxrslt = pdelim_(',',.false.,0)
         end if
         call tbxxpstr(strg(1:i))
         if (pdepth_.gt.0) pstatestack(pdepth_) = 2
210      if(.not.flag) then
           pchar = pcharl+4
           if (.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not in dictionary -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not in dictionary')
             call tbxxpstr(char(0))
           endif
         endif
         if((.not.tflag).and.line(1:i).ne.'.'.and.                      &
     &     line(1:i).ne.'?'.and.pqt.eq.' ') then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not correct type -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not correct type')
             call tbxxpstr(char(0))
           endif
         endif
         if (xmlout_) then
           if (ploopn.gt.1 .and. ploopc.gt.0) then
             call tbxxpxct(plhead(ploopc+1),plxhead(ploopc+1))
           endif
         endif


         pposval_=0
         pposdec_=0
         pposnam_=0
         pposend_=0
         pquote_=' '
         return

!
!        fold a string to min(pfold_,line_)
!
290      pchar=-1
         pqt = ';'
         pql = 1
         if (xmlout_) then
           call tbxxpstr('<![CDATA['//slash)
         else
           call tbxxpstr(';'//slash)
         endif
         kfold = min(pfold_,line_)
         call tbxxpfs(string(1:lstring),' ',kfold)
         pchar=-1
         ptextf='no '
         if (xmlout_) then
           call tbxxpstr(']]>')
         else
           call tbxxpstr(';')
         endif
         pchar=lprefx
         call tbxxpstr(' ')
         if (pdepth_.gt.0) pstatestack(pdepth_) = 2
         goto 210

         end
!
!
!
!
!
! >>>>>> Put a comment in the output CIF
!
         function pcmnt_(string)
!
         logical    pcmnt_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  string*(*), temp*(MAXBUF)
         character*3 pqt
         character*1 slash
         integer lstring, kfold, pql, ic, ik
         integer lastnb
!
         slash = rsolidus(1:1)
         lstring = lastnb(string)
         pqt = pquote_
         pql = lastnb(pquote_)
         kfold = min(pfold_,line_)
         if(ptextf.eq.'yes') call tbxxeot
         if(pposnam_.ne.0) pchar=pposnam_+lprefx
         if(string.eq.' '.or.                                           &
     &     (string.eq.char(0)) .or.                                     &
     &     (string.eq.tab.and.(.not.ptabx_))) then
           if(string.eq.' ') pchar=-1
           if (pqt.eq.'#') then
             temp(1:1+lstring) = pqt(1:pql)//string(1:lstring)
             call tbxxpstr(temp(1:1+lstring))
           else
             call tbxxpstr(string)
           endif
           if(string.eq.' ') call tbxxpstr(char(0))
         else
           if ((kfold .ne. 0) .and.                                     &
     &        ((xmlout_ .and. (max(pchar,1)+8+lstring.gt.kfold))        &
     &        .or.((.not.xmlout_) .and.                                 &
     &        ((max(pchar,1)+lstring).gt.kfold)))) then
           if (xmlout_) then
             call tbxxpstr('<!-- '//slash)
             call tbxxpfs(string(1:lstring),' ',kfold)
           else
             call tbxxpstr('#'//slash)
             call tbxxpfs(string(1:lstring),"#",kfold)
           endif
           call tbxxpstr(char(0))
           else
           if (xmlout_) then
             temp(1:5) = '<!-- '
             ik = 6
             do ic = 1,lastnb(string)
               if (string(ic:ic).eq.'-'.and.                            &
     &           temp(ik-1:ik-1).eq.'-'.and.                            &
     &           ik.lt.MAXBUF-4) then
                 temp(ik:ik) = slash
                 ik = ik+1
               endif
               if (ik.lt.MAXBUF-4) then
                 temp(ik:ik) = string(ic:ic)
                 ik = ik+1
               endif
             enddo
             temp(ik:ik+3) = ' -->'
             ik = ik+4
             if (ik.lt.MAXBUF) temp(ik:MAXBUF) = ' '
           else
             temp='#'//string
           endif
           call tbxxpstr(temp(1:lastnb(temp)))
           call tbxxpstr(char(0))
           endif
         endif
         pcmnt_=.true.
         pposnam_=0
         if(string.ne.tab)pchar=lprefx+1
         return
         end
!
!
!
!
!
!
!
! >>>>>> Put a text sequence into the CIF.
!
         function ptext_(name,string)
!
         logical    ptext_
         integer    lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical    flag,tflag
         integer    ll
         character  name*(*),temp*(NUMCHAR),string*(*),store*(NUMCHAR)
         character  mycat*(NUMCHAR),item*(NUMCHAR)
         character  myxcat*(XMLCHAR),xitem*(XMLCHAR)
         character  temp2*(MAXBUF)
         character  slash*1
         character*3 pqt
         integer    pql
         integer    kmn
         integer    kfold
         data       store/'                                '/
!
!DBG     print *,' ptext_, pclipt_ ', pclipt_
         ptext_=.true.
         flag  =.true.
         tflag =.true.
         slash = rsolidus(1:1)
         pqt = pquote_
         if (pqt .eq. ' ') pqt = ';'
         pql = lastnb(pqt)
         ll=lastnb(string)
         temp=name
         if(ptextf.eq.'no ')    goto 100
         if(temp.eq.store)      goto 150
         call tbxxeot
         if (pdepth_ .gt.0)  call tbxxebkt
!
100      if(name(1:1).ne.' ')   goto 110
         if(ptextf.eq.'yes')    goto 150
         goto 120
!
110      if(ploopn.ne.0)        call tbxxelp
         call tbxxgcat(name,'char',flag,tflag,mycat,myxcat,             &
     &     item,xitem,temp)
         ptext_=flag
         if (xmlout_) then
           if (plcat(1:1).ne.' ' .and. plcat.ne.mycat) then
             call tbxxpxct(plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             call tbxxpxct(plcat,plxcat)
             plcat = ' '
             plxcat = ' '
           endif
         endif
         pchar=-1
         if(pposnam_.ne.0) pchar=pposnam_+lprefx
         if (xmlout_) then
           if ((plhead(1)(1:1).ne.' '.and.plhead(1).ne.item)            &
     &       .or. plcat.ne.mycat) then
             call tbxxpxct (plhead(1),plxhead(1))
             plhead(1) = ' '
             if (plcat.ne.mycat) then
               call tbxxpxct(plcat,plxcat)
               plcat = mycat
               plxcat = myxcat
               call tbxxpxot(plcat,plxcat)
             endif
             call tbxxpxot (item,xitem)
           else
             if(plhead(1)(1:1).eq.' ') call tbxxpxot (item,xitem)
           endif
           plhead(1) = item
           plxhead(1) = xitem
         else
           call tbxxpstr(temp)
         endif
         if(.not.flag) then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not in dictionary -->')
             call tbxxpstr(char(0))
           else
             call tbxxpstr('#< not in dictionary')
             call tbxxpstr(char(0))
           endif
         endif
         if(.not.tflag) then
           if(.not.tabl_) pchar=lprefx+57
           if (xmlout_) then
             call tbxxpstr('<!-- not correct type -->')
           else
             call tbxxpstr('#< not correct type')
           endif
         endif
         go to 130
!
120      if (xmlout_) then
           if (ploopn.gt.0) then
             kmn = mod(ploopc,ploopn)+2
             if (ploopn.gt.1.or.ploopf.eq.'yes') then
               call tbxxpxot(plhead(kmn),plxhead(kmn))
             endif
           endif
         endif
!
130      if(ploopf.eq.'yes') ploopc=0
         ploopf='no '
         ptextf='yes'
         store=temp
         if (pfold_.eq.0) then
           pchar=-1
           if (xmlout_) then
             if (pclipt_ .and. string(1:1).eq.' '.and.ll.gt.1) then
               if (pqt.eq.';') then
             temp2 = '<![CDATA['//string(2:ll)
               else
                 temp2 = '<![CDATA['//pqt(1:pql)//string(2:ll)
               endif
             else
               if (pqt.eq.';') then
                 temp2 = '<![CDATA['//string(1:ll)
           else
                 temp2 = '<![CDATA['//pqt(1:pql)//string(1:ll)
               endif
             endif
           else
             if (pclipt_ .and. string(1:1).eq.' '.and.ll.gt.1) then
               temp2 = pqt(1:pql)//string(2:ll)
             else
               temp2 = pqt(1:pql)//string(1:ll)
             endif
           endif
           call tbxxpstr(temp2(1:lastnb(temp2)))
           pchar=-1
           return
         endif
         pchar=-1
         if (xmlout_) then
           if (pqt.eq.';') then
             call tbxxpstr('<![CDATA['//slash)
           else
             call tbxxpstr('pqt(1:pql)//<![CDATA['//slash)
           endif
         else
           call tbxxpstr(pqt(1:pql)//slash)
         endif
150      pchar=-1
         kfold = 0
         if (pfold_ .gt. 0 ) kfold = pfold_
         if (line_ .gt. 0 .and. pfold_ .gt. line_) then
            kfold = line_
         endif
         if (kfold .gt. 0) then
           call tbxxpfs(string,' ',kfold)
         else
           call tbxxpstr(string(1:max(1,ll)))
         endif
         continue
         pchar=-1
         pposnam_=0
         pposval_=0
         pposdec_=0
         pposend_=0
         return
         end
!
!
!
!
!
!
! >>>>>> Put a folded string to the output CIF
!
         subroutine tbxxpfs(string,prefix,kfold)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character *(*) string,prefix
         character *(MAXBUF) temp
         character *1 slash
         logical stabl
         integer kfold
         integer sploopn
         integer i, klow, khi, kpref, klen
         integer lastnb

         slash = rsolidus(1:1)
         sploopn = ploopn
         ploopn = -1
         stabl = tabl_
         tabl_ = .false.
         if (kfold .lt. 4) then
           call                                                         &
     &     tbxxwarn(                                                    &
     &       'Invalid attempt to fold output line, limit reset to 4')
           pfold_ = 4
           kfold = 4
         endif
         klen = lastnb(string)
         kpref = len(prefix)
         if (prefix.eq.' ') kpref=0
         klow = 1
 100     khi = klen
         if (khi.gt.klow+kfold-1-kpref) then
           khi = klow+kfold-1-kpref-1
           do i = khi,klow+1,-1
             if(string(i:i).eq.' ') then
               khi = i
               go to 120
             endif
           enddo
 120       if (kpref.gt.0) then
             temp(1:kpref+khi-klow+2) = prefix//string(klow:khi)//slash
           else
             temp(1:kpref+khi-klow+2) = string(klow:khi)//slash
           endif
           pchar = -1
           call tbxxpstr(temp(1:kpref+khi-klow+2))
           call tbxxpstr(char(0))
           klow = khi+1
           go to 100
         else
           if (string(khi:khi).eq.slash) then
             if (khi.lt.klow+kfold-1-kpref) then
                if (kpref.gt.0) then
                  temp(1:kpref+khi-klow+2) =                            &
     &              prefix//string(klow:khi)//slash
                  pchar = -1
                  call tbxxpstr(temp(1:kpref+khi-klow+2))
                  call tbxxpstr(char(0))
                  pchar = -1
                  call tbxxpstr(prefix)
                else
                  temp(1:khi-klow+2) = string(klow:khi)//slash
                  pchar = -1
                  call tbxxpstr(temp(1:khi-klow+2))
                  pchar = -1
                  call tbxxpstr(' ')
                endif
                call tbxxpstr(char(0))
             else
                if (kpref.gt.0) then
                  temp(1:kpref+khi-klow+1) = prefix//string(klow:khi)
                  pchar = -1
                  call tbxxpstr(temp(1:kpref+khi-klow+1))
                  call tbxxpstr(char(0))
                  temp(1:kpref+2) = prefix//slash//slash
                  pchar = -1
                  call tbxxpstr(temp(1:kpref+2))
                  call tbxxpstr(char(0))
                  call tbxxpstr(prefix)
                else
                  pchar = -1
                  call tbxxpstr(string(klow:khi))
                  call tbxxpstr(char(0))
                  pchar = -1
                  call tbxxpstr(slash//slash)
                  call tbxxpstr(char(0))
                  call tbxxpstr(' ')
                endif
                call tbxxpstr(char(0))
                pchar = -1
             endif
           else
             pchar = -1
             if (kpref.gt.0) then
               temp(1:kpref+khi-klow+1)=prefix//string(klow:khi)
               call tbxxpstr(temp(1:kpref+khi-klow+1))
             else
               call tbxxpstr(string(klow:khi))
             endif
             call tbxxpstr(char(0))
           endif
         endif
         pchar = -1
         ploopn = sploopn
         tabl_ = stabl
         return
         end
!
!
!
!
!
!
! >>>>>> Put a delimiter symbol into the CIF.
!
         function pdelim_(delim,force,posdlm)
!
         logical    pdelim_
         character*(*) delim
         logical    force
         integer    posdlm
         
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         pdelim_ = .true.
         if (ptextf.eq.'yes') call tbxxeot
         if (delim.eq.'('                                               &
     &     .or. delim.eq.'['                                            &
     &     .or. delim.eq.'{') then
           if (pdepth_.gt.0) then
             if (pstatestack(pdepth_).eq.2) then
               pposdlmstk(pdepth_+1) = pchar
               call tbxxpstr(',')
               pdelimstack(pdepth_+1) = ','
               pstatestack(pdepth_) = 1
             end if
           else
             if (ploopf.eq.'yes') ploopc=0
             ploopf='no '
             ploopc = ploopc+1
             if (ploopc.gt.ploopn) ploopc=ploopc-ploopn
           end if
           pdepth_ = pdepth_+1
           pbrackstack(pdepth_) = delim
           pdelimstack(pdepth_+1) = delim
           pstatestack(pdepth_) = 1
           pposbrkstk(pdepth_) = posdlm
           pposdlmstk(pdepth_+1) = posdlm 
           go to 100
         end if
         if (delim.eq.'}') then
           if (pdepth_.eq.0) then
             if (.not.force) pdelim_ = .false.
           else
             if (pbrackstack(pdepth_) .ne.'{'                           &
     &         .and. .not.force) pdelim_ = .false.
           end if
         end if
         if (delim.eq.')') then
           if (pdepth_.eq.0) then
             if (.not.force) pdelim_ = .false.
           else
             if (pbrackstack(pdepth_) .ne.'('                           &
     &         .and. .not.force) pdelim_ = .false.
           end if
         end if
         if (delim.eq.']') then
           if (pdepth_.eq.0) then
             if (.not.force) pdelim_ = .false.
           else
             if (pbrackstack(pdepth_) .ne.'['                           &
     &         .and. .not.force) pdelim_ = .false.
           end if
         end if
         if (delim.eq.':' .and. pdelimstack(pdepth_+1).eq.':') then
            if (.not.force) pdelim_= .false.
         end if
         if (.not.pdelim_) return
         if (delim.eq.'}' .or. delim.eq.']' .or. delim.eq.')') then
           pdepth_ = pdepth_-1
!DBG       print *,' decreasing pdepth ',pdepth_, precn_
           if (pdepth_ .gt.0) pstatestack(pdepth_) = 2
           go to 100
         end if
         if (delim.eq.',' .or. delim.eq.':') then
           pstatestack(pdepth_) = 1
           pdelimstack(pdepth_+1) = delim
           pposdlmstk(pdepth_+1) = posdlm
         end if
100      continue 
         if (posdlm.ne.0) pchar = lprefx+posdlm
         call tbxxpstr(delim)
         return
         end
         
!
!
!
!
!
!
! >>>>>> Put a loop_ data name into the CIF.
!
         function ploop_(name)
!
         logical    ploop_
         integer    kpc,kpl,npl
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical    flag,tflag
         character  name*(*), temp*(NUMCHAR), mycat*(NUMCHAR)
         character  myxcat*(XMLCHAR),xitem*(XMLCHAR)
         character  item*(NUMCHAR), str*(NUMCHAR)
         character  shead*(NUMCHAR),xshead*(XMLCHAR)
         integer    lastnb
!
         ploop_=.true.
         flag  =.true.
         if(ptextf.eq.'yes')    call tbxxeot
         if (pdepth_ .gt.0)     call tbxxebkt
         if(ploopn.ne.0 .and. ploopf.ne.'yes' .and. name(1:1).eq.' ') then
           call tbxxelp
         endif
         temp = ' '
         mycat = ' '
         item = ' '
         shead = plhead(1)
         xshead = plxhead(1)(1:min(XMLCHAR,NUMCHAR))
         str = ' '
         if(name(1:1).eq.' ')   goto 100
!
         call tbxxgcat(name,'    ',flag,tflag,mycat,myxcat,             &
     &     item,xitem,str)
         ploop_ = flag
         if (ploopn.ne.0 .and. ploopf.ne.'yes') then
           if (plcat.eq.mycat) then
             plcat = ' '
             call tbxxelp
             plcat = mycat
             plxcat = myxcat
           else
             call tbxxelp
           endif
         endif
         if (xmlout_) then
           if (plcat(1:1).ne.' '.and.ploopn.eq.0) then
             call tbxxpxct(plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
             shead = ' '
             xshead = ' '
             if (plcat.ne.mycat) then
               call tbxxpxct(plcat,plxcat)
               plcat = ' '
               plxcat = ' '
             endif
           endif
         endif
         if(tabl_.and.pposnam_.eq.0) then
           temp='    '//str(1:NUMCHAR-4)
         else
           temp=str
         endif
         plhead(max(ploopn,0)+2) = item
         plxhead(max(ploopn,0)+2) = xitem
100      if(ploopn.ne.0)        goto 120
         ploopf='yes'
         pchar=-1
         if(pposval_.ne.0) then
           pchar=lprefx+1
!           call tbxxpstr(' ')
           pchar=pposval_+lprefx
         else
           if(pposnam_.ne.0) then
             pchar=lprefx+1
             call tbxxpstr(' ')
             pchar=pposnam_+lprefx+1
           endif
         endif
         if (xmlout_) then
           if (shead(1:1).ne.' ') then
             call tbxxpxct (shead,xshead)
           endif
         else
           call tbxxpstr('loop_')
         endif
         pchar=-1
         if(name(1:1).eq.' ') then
           ploopn=-1
           plhead(1) = ' '
           plxhead(1) = ' '
           return
         endif
120      if(ploopn.le.0) then
           if (xmlout_.and.plcat.ne.mycat) then
             call tbxxpxct(plcat,plxcat)
             plcat = mycat
             plxcat = myxcat
             call tbxxpxot(mycat,myxcat)
           endif
         else
           if(xmlout_ .and. plcat.ne.mycat) then
             kpl = lastnb(plcat)
             if(mycat(1:1).eq.' ') then
                mycat = '(none)'
                myxcat = '_NONE_ '
             endif
             npl = lastnb(mycat)
             kpc = pchar
             call tbxxpstr('<!--  mixed categories '//plcat(1:kpl)      &
     &                      //' and '//mycat(1:npl)//' -->')
             pchar = kpc
           endif
         endif
         if(pposnam_.ne.0) pchar=pposnam_+lprefx
         if (.not. xmlout_) then
           call tbxxpstr(temp(1:lastnb(temp)))
         endif
         if(flag)               goto 130
         if(.not.tabl_) pchar=lprefx+57
         if (xmlout_) then
           call tbxxpstr('<!-- '//temp(1:lastnb(temp))//                &
     &     ' not in dictionary -->')
           call tbxxpstr(char(0))
         else
           call tbxxpstr('#< not in dictionary')
           call tbxxpstr(char(0))
         endif
130      pchar=lprefx+1
         ploopn=max(ploopn,0)+1
         ploopc = 0
!
         return
         end
!
!
!
!
!
! >>>>>> Create or clear a prefix string
!        Any change in the length of the prefix string flushes
!        pending text, if any,  loops and partial output lines
!
         function prefx_(strg,lstrg)
!
         logical    prefx_
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  strg*(*)
         integer    lstrg,mxline
!
         mxline=MAXBUF
         if(line_.gt.0) mxline=min(line_,MAXBUF)
         if(lstrg.ne.lprefx.and.pcharl.gt.0) then
           pchar=-1
           call tbxxpstr(' ')
         endif
         if (lstrg.le.0) then
           prefx=' '
           if(pchar.ge.lprefx+1)pchar=pchar-lprefx
           lprefx=0
         else
           if(lstrg.gt.mxline) then
             call tbxxwarn(' Prefix string truncated')
           endif
           prefx=strg
           if(pchar.ge.lprefx+1)pchar=pchar-lprefx+lstrg
           obuf(1:min(mxline,lstrg))=prefx
           lprefx=lstrg
           if(mxline-lprefx.lt.NUMCHAR) then
             call tbxxwarn(' Output prefix may force line overflow')
           endif
         endif
         prefx_=.true.
         return
         end
!
!
!
!
!
!
! >>>>>> Close the CIF
!
         subroutine close_
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  tbxxxsub*(MAXBUF)
!
         if(ptextf.eq.'yes') call tbxxeot
         if (pdepth_ .gt.0)  call tbxxebkt
         if(ploopn.ne.0)     call tbxxelp
         if (xmlout_) then
           if (plhead(1)(1:1).ne.' ')                                   &
     &       call tbxxpxct(plhead(1),plxhead(1))
           if (plcat(1:1).ne.' ') call tbxxpxct(plcat,plxcat)
           if (pdblok(1:1).ne.' ')  then
             if (xmdata.eq.0) then
               call tbxxpxct(pdblok,' ')
             else
               call tbxxpxct(tbxxxsub(pdblok,xmlate(xmdata)),' ')
             endif
           endif
         endif
         pdblok = ' '
         plcat = ' '
         plxcat = ' '
         plhead(1) = ' '
         plxhead(1) = ' '
         if(pcharl.ge.lprefx+1) then
           pchar=-1
           call tbxxpstr(' ')
         endif
         if (file_(1:1) .ne. ' ') then
           file_(1:longf_) = ' '
           longf_ = 1
           close(outdev)
           precn_=0
         endif
         return
         end
!
!
! >>>>>  Clean out characters not valid for an XML name
!
!        An XML name may begin with a letter, '_' or ':'
!        and may contain letters, digits, '_', ':', '.' or '-'
!
!        Note that the full Unicode character set would also permit
!        combining characters and extender characters, but these
!        have no representation in a 128 character ASCII set
!
!
         function tbxxxcln(xstring,lstr)
         logical tbxxxcln
         character*(*) xstring
         integer lstr, ii, ix
         character*10 chkstr1
         character*28 chkstr2
         character*28 chkstr3
         character*1 c
         data chkstr1/'0123456789'/
         data chkstr2/'_:ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
         data chkstr3/'abcdefghijklmnopqrstuvwxyz.-'/
         tbxxxcln = .true.
         do ii = 1,lstr
           c = xstring(ii:ii)
           if (c.eq.' ') return
           ix = index(chkstr2,c)
           if (ix.eq.0) then
             ix = index(chkstr3,c)
             if (ix.eq.0.and.ii.gt.1) then
               ix = index(chkstr1,c)
             endif
             if(ix.eq.0.or.(ix.gt.26.and.ii.eq.1)) then
               xstring(ii:ii) = '_'
               tbxxxcln = .false.
             endif
           endif
         enddo
         return
         end




!
!
! >>>>>> Put out the given string as an xml open tag
!
!        Note that the string may have embedded blanks and
!        parameters.  The second argument is an optional
!        translation to be used if non-blank.
!
         subroutine tbxxpxot(string,xstring)
!
         integer lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character sbuf*(MAXBUF)
         character*(*) string, xstring
         integer ik
         logical tbxxxcln

         if (string(1:1).eq.' ') return
         sbuf(1:1) = '<'
         if (xstring(1:1).eq.' ') then
           ik = lastnb(string)
           sbuf(2:ik+1)=string(1:ik)
         else
           ik = lastnb(xstring)
           sbuf(2:ik+1)=xstring(1:ik)
         endif
         sbuf(ik+2:ik+2) = '>'
         pchar = -1
         if (.not.tbxxxcln(sbuf(2:ik+1),ik)) then
           call tbxxwarn(' XML required remapping for '//sbuf(2:ik+1))
         endif
         call tbxxpstr(sbuf(1:ik+2))
         return
         end


!
!
! >>>>>> Put out the given string as an xml close tag
!
!        Note that the string may have embedded blanks and
!        parameters.  Only the first token will be used for close.
!        The second argument is an optional translation to be
!        used if non-blank
!
         subroutine tbxxpxct(string, xstring)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character sbuf*(MAXBUF)
         character*(*) string, xstring
         integer ik
         logical tbxxxcln

         if (string(1:1).eq.' ') return
         sbuf(1:2) = '</'
         if (xstring(1:1).eq.' ') then
           do ik = 1,len(string)
             if (string(ik:ik).eq.' ') go to 100
           enddo
           ik = len(string)+1
 100       ik = ik-1
           sbuf(3:ik+2)=string(1:ik)
         else
           do ik = 1,len(xstring)
             if (xstring(ik:ik).eq.' ') go to 200
           enddo
           ik = len(xstring)+1
 200       ik = ik-1
           sbuf(3:ik+2)=xstring(1:ik)
         endif
         sbuf(ik+3:ik+3) = '>'
         if (.not.tbxxxcln(sbuf(3:ik+2),ik)) then
           call tbxxwarn(' XML required remapping for '//sbuf(3:ik+2))
         endif
         pchar = -1
         call tbxxpstr(sbuf(1:ik+3))
         return
         end

!
!
!
!
!
! >>>>>> Put the string into the output CIF buffer
!
         subroutine tbxxpstr(string)
!
         integer    lastnb
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         SAVE
         character  string*(*),temp*(MAXBUF),bfill*(MAXBUF)
         character  temp2*(MAXBUF)
         integer    i,ii,mxline,ioffst,ifree,icpos,itpos
         integer    ixpos,ixtpos,it,im,kbin,kpass
         integer    lstring
         logical    pflush,waslop
         data       waslop /.false./

!
!DBG     print *,' entry to tbxxpstr, pchar, pcharl, string'
!DBG     print *, pchar, ', ',pcharl,', ', string
         bfill = ' '
         lstring = min(MAXBUF,lastnb(string))
         mxline=MAXBUF
         if(line_.gt.0) mxline=min(line_,MAXBUF)
         if(pfold_.gt.0) then
           if (pfold_ .lt. lprefx+lstring) then
             call tbxxwarn('Invalid value of pfold_, reset')
             pfold_ = min(line_,lprefx+lstring)
           endif
           mxline=min(mxline,pfold_)
         endif
         temp(1:lstring)=string
         temp2=temp
         pflush=.false.
         if(pchar.lt.0) pflush=.true.
!
         do 100 i=lstring,1,-1
         if(temp(i:i).eq.' ')              goto 100
         if(ptabx_.and.temp(i:i).eq.tab) goto 100
         goto 110
100      continue
         i=0
         it=i
!
!....... Organise the output of loop_ items
!
110      if(i.eq.0)             goto 130
         if(i.eq.1.and.string.eq.tab) goto 130
         if(i.eq.1.and.string.eq.char(0)) then
           pcharl=MAXBUF
           goto 200
         endif
         if((.not.xmlout_).and.temp(1:1).eq.'#')   goto 130
         if(xmlout_.and.temp(1:1).eq.'<') go to 130
         if(ploopf.eq.'yes')    goto 130
         if(ptextf.eq.'yes')    goto 130
         if(ploopn.le.0)        goto 130
         if(pdepth_.gt.0)       goto 130
         ploopc=ploopc+1
         if((align_.or.tabl_).and.pdepth_.eq.0 )then
           if(ploopc.gt.ploopn) then
             if(pcharl.gt.lprefx) pflush=.true.
             ploopc=1
             if(pchar.gt.0) pchar=lprefx+1
           endif
           if(pchar.lt.0)    goto 130
           if(tabl_) then
           kbin=(mxline-lprefx)/8
           if(ploopn.lt.kbin) then
             if(kbin/(ploopn+1).gt.1) then
             pchar=9+lprefx+                                            &
     &         (ploopc-1)*8*(kbin/(ploopn+1))
             else
             pchar=1+lprefx+                                            &
     &         (ploopc-1)*8*(kbin/ploopn)
             endif
           else
             if(ploopc.le.kbin) then
               pchar=1+lprefx+(ploopc-1)*8
             else
               kpass=(ploopc-kbin-1)/(kbin-1)+1
               pchar=2*kpass+1+lprefx+                                  &
     &           mod(ploopc-kbin-1,kbin-1)*8
             endif
           endif
           else
             if(ptabx_) then
             icpos=1
             itpos=1
120          ixpos = 0
             if (icpos.le.i) ixpos=index(temp(icpos:i),tab)
             ixtpos=(pchar+itpos-1+ixpos)
             ixtpos=((ixtpos+7)/8)*8
             if(ixpos.gt.0) then
               if(ixpos.gt.1) then
                 temp2(itpos:ixtpos-pchar+1)=temp(icpos:ixpos-1)
               else
                 temp2(itpos:ixtpos-pchar+1)=' '
               endif
               icpos=ixpos+1
               itpos=ixtpos+2-pchar
               if(icpos.le.i) goto 120
               it=itpos-1
             else
               if(icpos.le.i) then
                 temp2(itpos:itpos+i-icpos)=temp(icpos:i)
                 it=itpos+i-icpos
               endif
             endif
             endif
             if((pchar+i).gt.mxline+1.or.                               &
     &          (ptabx_.and.pchar+it.gt.mxline+1)) then
               if(pcharl.gt.lprefx)pflush=.true.
               pchar=lprefx+1
             endif
           endif
         else
           if(ploopc.le.ploopn)   goto 130
           ploopc=mod(ploopc-1,ploopn)+1
         endif
!
!....... Is the buffer full and needs flushing?
!
130      if(i.eq.1.and.string.eq.tab) then
           if(pcharl.gt.lprefx) then
             if(obuf(pcharl:pcharl).eq.' ') pcharl=pcharl-1
           endif
         endif
         if(pdepth_.gt.0                                                &
     &     .and.string(1:1).eq.'#'                                      &
     &     .and. pcharl.gt.lprefx) then
           if (obuf(pcharl:pcharl).ne.' ') then
             pcharl = pcharl+1
             obuf(pcharl:pcharl) = ' '
           end if
         end if
         if(pchar.le.pcharl.and.pcharl.gt.lprefx) pflush=.true.
         pchar=max(lprefx+1,pchar)
         if (string.ne.'('                                              &
     &     .and.string.ne.'['                                           &
     &     .and.string.ne.'{'                                           &
     &     .and.string.ne.')'                                           &
     &     .and.string.ne.']'                                           &
     &     .and.string.ne.'}'                                           &
     &     .and.string.ne.','                                           &
     &     .and.string.ne.':'                                           &
     &     .and.(ploopf.eq.'yes'.or.ploopn.le.0).and.tabl_)             &
     &     pchar=((pchar-lprefx+6)/8)*8+1+lprefx
         if(ptabx_) then
           icpos=1
           itpos=1
135        ixpos=0
           if(icpos.le.i) ixpos=index(temp(icpos:i),tab)
           ixtpos=(pchar+itpos-1+ixpos)
           ixtpos=((ixtpos+7)/8)*8
           if(ixpos.gt.0) then
             if(ixpos.gt.1) then
               temp2(itpos:ixtpos-pchar+1)=temp(icpos:ixpos-1)
             else
               temp2(itpos:ixtpos-pchar+1)=' '
             endif
             icpos=ixpos+1
             itpos=ixtpos+2-pchar
             if(icpos.le.i) goto 135
             it=itpos-1
           else
             if(icpos.le.i) then
               temp2(itpos:itpos+i-icpos)=temp(icpos:i)
               it=itpos+i-icpos
             endif
           endif
         endif
         if((pchar+i).gt.mxline+1.or.                                   &
     &     (ptabx_.and.pchar+it.gt.mxline+1)) then
            pflush=.true.
            pchar=mxline+1-i
            if (xmlout_) pchar = 1
            if (pdepth_.gt.0) then
              pchar = 1
              if (pposbrkstk(pdepth_)+i.lt.mxline)                      &
     &          pchar = pposbrkstk(pdepth_)+1
            end if
            pchar=max(lprefx+1,pchar)
         endif
         if(.not.pflush)  goto 150
         if(pcharl.gt.lprefx) then
           if(waslop.or.(.not.tabl_)) goto 145
           ioffst=0
           pcharl=max(lastnb(obuf(1:pcharl)),lprefx+1)
           ifree=mxline-pcharl
           if(ifree.gt.0) then
           im=numtab+2
           if(numtab.gt.0.and.numtab.le.MAXTAB) then
             if(obuf(itabp(numtab):itabp(numtab)).eq.'#')               &
     &         im=im-1
           endif
           if(ifree.ge.16.and.im.lt.4.and.                              &
     &       (obuf(1+lprefx:1+lprefx).ne.'#'                            &
     &        .and.((.not.xmlout_).or.(                                 &
     &             obuf(1+lprefx:1+lprefx).ne.'<'                       &
     &        .and.obuf(1+lprefx:1+lprefx).ne.']'))                     &
     &        .and.obuf(1+lprefx:1+lprefx).ne.';'                       &
     &        .and.obuf(1+lprefx:1+lprefx).ne.'_'                       &
     &        .and.obuf(1+lprefx:1+lprefx).ne.' '                       &
     &        .and.obuf(1+lprefx:5+lprefx).ne.'data_'                   &
     &        .and.obuf(1+lprefx:5+lprefx).ne.'save_'                   &
     &        .and.obuf(1+lprefx:5).ne.'loop_')) then
             temp(1+lprefx:pcharl)=obuf(1+lprefx:pcharl)
             obuf(1+lprefx:pcharl+8)=                                   &
     &         bfill(1:8)//temp(1+lprefx:pcharl)
             ioffst = 8
             ifree=ifree-8
             pcharl=pcharl+8
           endif
           do ii=1,min(MAXTAB,numtab)
             icpos=itabp(ii)+ioffst
             if(icpos.gt.pcharl)   goto 145
             if(im.lt.4) then
             itpos=(max(icpos-lprefx,                                   &
     &         ii*(mxline-lprefx)/im)+6)/8
             itpos=itpos*8+1+lprefx
             else
             itpos=(max(icpos-lprefx,                                   &
     &         ii*(mxline-lprefx)/im)+4)/6
             itpos=itpos*6+1+lprefx
             endif
             if((obuf(icpos:icpos).eq.''''.or.                          &
     &          obuf(icpos:icpos).eq.'"').and.                          &
     &          itpos.gt.icpos) itpos=itpos-1
             if(itpos-icpos.gt.ifree) itpos=icpos+ifree
             if(itpos.gt.icpos) then
               temp(1:pcharl-icpos+1)=                                  &
     &           obuf(icpos:pcharl)
               if(i.lt.numtab) then
                 ixpos=itabp(ii+1)+ioffst
                 if(ixpos.gt.icpos+itpos-icpos+1) then
                   if(obuf(ixpos-(itpos-icpos+1):ixpos-1).eq.           &
     &               bfill(1:itpos-icpos+1)) then
                     temp(ixpos-itpos+1:pcharl-itpos+1)=                &
     &               obuf(ixpos:pcharl)
                     pcharl=pcharl-(itpos-icpos)
                   endif
                 endif
               endif
               obuf(icpos:pcharl+itpos-icpos)=                          &
     &           bfill(1:itpos-icpos)//temp(1:pcharl-icpos+1)
               ifree=ifree-(itpos-icpos)
               ioffst=ioffst+itpos-icpos
               pcharl=pcharl+itpos-icpos
             endif
             if(ifree.le.0)      goto 145
           enddo
           endif
145        pcharl=max(1,lastnb(obuf))
           write(outdev,'(a)') obuf(1:pcharl)
         else
           if(precn_.gt.0) then
           if(lprefx.gt.0) then
           write(outdev,'(a)') obuf(1:lprefx)
           else
           write(outdev,'(a)')
           endif
           else
           precn_=precn_-1
           endif
         endif
         waslop=.false.
         precn_=precn_+1
         do ii = 1,MAXTAB
           itabp(ii)=0
         enddo
         numtab=0
         if(lprefx.gt.0) then
           obuf=prefx(1:lprefx)
         else
           obuf=' '
         endif
!
!....... Load the next item into the buffer
!
150      pcharl=pchar+i
         if(ptabx_) pcharl=pchar+it
         waslop= ploopf.eq.'no '.and.ploopn.gt.0.and.align_
         if(i.eq.0) then
           if(pcharl.eq.lprefx+1.and.                                   &
     &       obuf(lprefx+1:lprefx+1).eq.' ') pcharl=pcharl-1
             pchar=pcharl+1
             if (pdepth_.gt.0) then
               if(pcharl.gt.lprefx+1                                    &
     &           .and.obuf(pcharl:pcharl).eq.' ') then
                 pchar = pcharl
                 pcharl = pcharl-1
               end if
             endif
           goto 200
         endif
         if(ptabx_) then
           obuf(pchar:pcharl)=temp2(1:it)
         else
           if(string.eq.tab) pcharl=pcharl-1
           obuf(pchar:pcharl)=string(1:i)
         endif
         if(pchar.gt.1+lprefx) then
           numtab=numtab+1
           if(numtab.le.MAXTAB) itabp(numtab)=pchar
         endif
         pchar=pcharl+1
         if (pdepth_.gt.0.and.pcharl.gt.lprefx+1                        &
     &     .and.obuf(pcharl:pcharl).eq.' ') then
           pchar = pcharl
           pcharl = pcharl-1
         endif
         if(pchar.gt.mxline+2) then
           if (pfold_.eq.0) then
             call tbxxwarn(' Output CIF line longer than line_')
           else
             call tbxxwarn(                                             &
     &         ' Output CIF line longer than line_ or pfold_')
           endif
         endif
!
200      continue
!
!DBG     print *,' exit from tbxxpstr, pchar, pcharl, obuf'
!DBG     print *, pchar, ', ',pcharl,', ', obuf(1:pcharl)

         return
         end
!
!
!
!
!
! >>>>>> Convert the number and esd to string nnnn(m), limited
!        by relative precision prec
!
         subroutine tbxxpnum(numb,sdev,prec)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         character  string*30,temp*30,c*1,sfmt*8
         double precision numb,sdev,prec,xxnumb,xsdev,slog
         integer    i,iexp,ifp,ii,jj,j,jlnz,jn,kexp,m,ixsdev,islog
         integer    kdecp,ibexp,lexp
!
         kdecp=0
         lexp = 0
         jn = 0
         if (sdev.gt.abs(numb)*prec) then
           if (iabs(esdlim_).ne.esdcac) then
!
!            determine the number of digits set by esdlim_
!
             if (iabs(esdlim_).lt.9 .or.iabs(esdlim_).gt.99999) then
               call tbxxwarn(' Invalid value of esdlim_ reset to 19')
               esdlim_ = 19
             endif
!
!            determine the number of esd digits
!
             esddigx = int(1.+alog10(float(iabs(esdlim_))))
             esdcac = iabs(esdlim_)
           endif
!
!          if esdlim_ < 0, validate pesddig_
!
           if (esdlim_.lt. 0 )then
             if (pesddig_.lt.0 .or. pesddig_.gt.5) then
               call tbxxwarn(' Invalid value of pesddig_ reset to 0')
               pesddig_ = 0
             endif
           endif
!
!          determine kexp, the power of 10 necessary
!          to present sdev as an integer in the range
!          (esdlim_/10,esdlim_] or [1,-esdlim_] if esdlim_ < 0
!
           slog = dlog10(sdev)
           islog = int(slog+1000.)
           islog = islog-1000
           kexp = -islog+esddigx
!
!          Adjust exponent kexp, so that sdev*10**kexp
!          is in the interval (esdlim_/10,esdlim_] or [1,-esdlim_]
!
 20        if (kexp.lt.minexp) then
             call tbxxwarn(' Underflow of esd')
             ixsdev = 0
             go to 30
           endif
           if (kexp.gt.-minexp) then
             call tbxxwarn(' Overflow of esd')
             ixsdev = 99999
             go to 30
           endif
           xsdev = sdev*10.D0**kexp
           ixsdev = int(xsdev+.5)
           if (ixsdev.gt.iabs(esdlim_)) then
             kexp = kexp -1
             go to 20
           endif
           if (ixsdev.lt.(iabs(esdlim_)+5)/10) then
             kexp = kexp+1
             go to 20
           endif
!
!          lexp holds the number of trailing zeros which may be
!          sacrificed in the esd if the number itself has
!          trailing zeros in the fraction which is permitted if
!          esdlim_ is negative
!
!          If esdlim_ is negative and pesddig_ is .gt.0,
!          pesddig_ will be used to force the number of digits
!          in which case lexp has the number of digits that
!          must be sacrificed (lexp > 0) or zeros to add (lexp < 0)
!
           lexp=0
           if(esdlim_.lt.0) then
             if(pesddig_.gt.0) then
25             continue
               if(ixsdev*10**(-lexp).ge.10**(pesddig_))then
                 if(lexp.gt.0)                                          &
     &             ixsdev=ixsdev-5*10**(lexp-1)
                 ixsdev=ixsdev+5*10**lexp
                 lexp=lexp+1
                 goto 25
               endif
               if(ixsdev.lt.10**(pesddig_-1+lexp)                       &
     &           .and.lexp.gt.0) then
                 if(ixsdev*10**(-lexp).le.iabs(esdlim_))then
                   lexp =lexp-1
                   if(lexp.ge.0) then
                     ixsdev=ixsdev-5*10**lexp
                   endif
                   if(lexp.gt.0) then
                     ixsdev=ixsdev+5*10**(lexp-1)
                   endif
                   goto 25
                 endif
               endif
               kexp=kexp-lexp
               ixsdev = ixsdev/(10**lexp)
               lexp=0
             else
             do ii = 1,4
               if(mod(ixsdev,10**ii).ne.0) go to 30
               lexp = ii
             enddo
             endif
           endif
!
!          We need to present the number to the same scaling
!          at first, but will adjust to avoid Ennn notation
!          if possible
!
 30        xxnumb = dabs(numb)*10.d0**kexp+.5
           if(xxnumb*prec .gt.1.D0) then
             call tbxxwarn(' ESD less than precision of machine')
             ixsdev=0
           endif
           if(numb.lt.0.d0) xxnumb = -xxnumb
           write(string,ndpfmt)xxnumb
           if(xxnumb.lt.1.d0 .and. xxnumb.ge.0.d0)                      &
     &        string='                         0.0E0'
           if(xxnumb.gt.-1.d0 .and. xxnumb.lt.0.d0)                     &
     &        string='                        -0.0E0'
!
!          Extract the power of 10
!
           iexp = 0
           ibexp = 0
           do ii = 0,4
             i = 30-ii
             c = string(i:i)
             m = index('0123456789',c)
             if (m.gt.0) then
               iexp = iexp+(m-1)*10**(ii-ibexp)
             else
               if (c.eq.' ') then
                 ibexp = ibexp+1
               else
               if (c.eq.'-') iexp=-iexp
               goto 40
               endif
             endif
           enddo
           call tbxxerr(' Internal error in tbxxpnum')
!
!          Scan the rest of the string shifting the
!          decimal point to get an integer
!
40         ifp = 0
           j=1
           do ii = 1,i-1
           c = string(ii:ii)
           if (c.ne.' ')then
             m=index('0123456789+-',c)
             if(m.ne.0) then
               temp(j:j)=c
               if(j.gt.1.or.c.ne.'0')j=j+1
               if(j.eq.3.and.temp(1:2).eq.'-0')j=j-1
               if(ifp.ne.0)then
                 iexp=iexp-1
                 if(iexp.le.0) goto 50
               endif
             else
               if(c.eq.'.') then
                 ifp=1
                 if(iexp.le.0) goto 50
               endif
             endif
           endif
           enddo
!
!          The string from 1 to j-1 has an integer
!          If iexp < 0, we present a 0.  If iexp > 0
!          we pad with zeros
!
50         if(j.eq.2 .and. temp(1:1).eq.'-') then
              temp(1:2)='-0'
              j=3
              iexp=0
           endif
           if(j.eq.1 .or. iexp.lt.0) then
             temp(1:1)='0'
             j=2
             iexp = 0
             if(xxnumb.lt.0.d0) then
               temp(1:2)='-0'
               j=3
             endif
           endif
           if (iexp.gt.0) then
             do ii = 1,iexp
             temp(j:j)='0'
             j=j+1
             enddo
             iexp=0
           endif
           string=temp(1:j-1)
!
!          We have the number for which the presentation
!          would be nnnnnE-kexp.  If kexp is gt 0, we can
!          decrease it and introduce a decimal point
!
           jj=0
           if(index('0123456789',temp(1:1)).eq.0) jj=1
           if(kexp.gt.0.and.kexp.lt.j-jj+8) then
             if(kexp.lt.j-1) then
               if(plzero_ .and.                                         &
     &           j-1-kexp.eq.1.and.temp(1:1).eq.'-') then
                 string=temp(1:j-1-kexp)//'0.'//                        &
     &             temp(j-kexp:j-1)
                 j=j+2
               else
                 string=temp(1:j-1-kexp)//'.'//                         &
     &           temp(j-kexp:j-1)
                 j=j+1
               endif
               kexp = 0
             else
               if(jj.ne.0)string(1:1)=temp(1:1)
               if(plzero_) then
                 string(1+jj:2+jj)='0.'
                 do ii=1,kexp-(j-1-jj)
                   string(2+jj+ii:2+jj+ii)='0'
                 enddo
                 string(3+jj+(kexp-(j-1-jj)):30)=                       &
     &             temp(1+jj:j-1)
                 j=j+2+kexp-(j-1-jj)
               else
                 string(1+jj:1+jj)='.'
                 do ii=1,kexp-(j-1-jj)
                   string(1+jj+ii:1+jj+ii)='0'
                 enddo
                 string(2+jj+(kexp-(j-1-jj)):30)=                       &
     &             temp(1+jj:j-1)
                 j=j+1+kexp-(j-1-jj)
               endif
               kexp=0
             endif
           endif
           kdecp=index(string(1:j-1),'.')
           if(kdecp.gt.0.and.kdecp.lt.j-1.and.lexp.gt.0) then
             jj=0
             do ii = 1,min(lexp,j-1-kdecp)
               c = string(j-ii:j-ii)
               if(c.ne.'0') goto 60
               jj=jj+1
             enddo
60           j=j-jj
             ixsdev=ixsdev/10**jj
             if(.not.pdecp_.and.string(j-1:j-1).eq.'.') then
               j=j-1
               kdecp=0
             endif
           endif
           if(kdecp.eq.0) then
             kdecp=j
             if(pdecp_) then
               if(plzero_.and.                                          &
     &           (j.eq.1 .or. (j.eq.2.and.string(1:1).eq.'-'))) then
                 string(j:j)='0'
                 j=j+1
               endif
               string(j:j)='.'
               j=j+1
             endif
           endif
           if(kexp.ne.0) then
             write(temp(1:5),'(i5)') -kexp
             string(j:j)='E'
             j=j+1
             do ii=1,5
               c=temp(ii:ii)
               if(c.ne.' ') then
                 string(j:j)=c
                 j=j+1
               endif
             enddo
           endif
!
!          if there is a standard deviation
!          append it in parentheses
!
           if(ixsdev.ne.0) then
             write(temp(1:5),'(i5)') ixsdev
             string(j:j)='('
             j=j+1
             do ii=1,5
               c=temp(ii:ii)
               if(c.ne.' ') then
                 string(j:j)=c
                 j=j+1
               endif
             enddo
             string(j:j)=')'
             j=j+1
           endif
         else
!
!          There is no standard deviation, just write numb
!          But limit to the digits implied by prec
!
           slog = dlog10(min(.1D0,max(prec,dpprc)))
           islog = int(slog+1000.5)
           islog = islog-1000
           kexp = -islog
           write(sfmt,'(5h(D30.,i2,1h))') kexp
           write(temp,sfmt)numb
!
!          Now have the number in the form
!          [sign][0].nnnnnnnnDeee
!          which, while sufficient, is not neat
!          we reformat for the case 0<=eee<=kexp
!
!
!          Extract the power of 10
!
           iexp = 0
           ibexp = 0
           do ii = 0,4
             i = 30-ii
             c = temp(i:i)
             m = index('0123456789',c)
             if (m.gt.0) then
               iexp = iexp+(m-1)*10**(ii-ibexp)
             else
               if (c.eq.' ') then
                 ibexp = ibexp+1
               else
               if (c.eq.'-') iexp=-iexp
               goto 140
               endif
             endif
           enddo
           call tbxxerr(' Internal error in tbxxpnum')
!
!          Scan the rest of the string shifting the
!          decimal point to get a number with exponent 0,
!          if possible
!
140        ifp = 0
           j=1
           do ii = 1,i-1
           jn=ii
           c = temp(ii:ii)
           if (c.ne.' ')then
             m=index('0123456789+-',c)
             if(m.ne.0) then
               string(j:j)=c
               if(j.gt.1.or.c.ne.'0')j=j+1
               if(j.eq.3.and.string(1:2).eq.'-0')j=j-1
               if(ifp.ne.0)then
                 iexp=iexp-1
                 if(iexp.le.0) goto 150
               endif
             else
               if(c.eq.'.') then
                 ifp = -1
                 if(iexp.le.0) goto 150
               endif
             endif
           endif
           enddo
150        if(plzero_ .and.                                             &
     &       (j.eq.1 .or.(j.eq.2.and.string(1:1).eq.'-'))) then
             string(j:j)='0'
             j=j+1
           endif
           string(j:j)='.'
           ifp = j
           j = j+1
           jlnz = j-1
           do ii = jn+1,i-1
             c = temp(ii:ii)
             if (c.ne.' ')then
               m=index('0123456789',c)
               if(m.ne.0) then
                 string(j:j)=c
                 j=j+1
                 if(m.ne.1)jlnz=j
                 if(m.eq.1.and.ifp.ge.1.and.                            &
     &             pposdec_.ne.0.and.pposend_.ne.0) then
                   if(j-1-ifp-min(iexp,0).le.pposend_-pposdec_)         &
     &               jlnz=j
                 endif
               else
                 goto 160
               endif
             endif
           enddo
160        j=jlnz
           if(j.eq.1) then
            string(1:1)='0'
            j=2
           endif
           if(iexp.lt.0.and.iexp.gt.-7.and.ifp.lt.j-1.and.              &
     &       ifp.ne.0.and.j-ifp-iexp.le.kexp) then
             temp(1:ifp)=string(1:ifp)
             do ii = 1,-iexp
               temp(ifp+ii:ifp+ii) = '0'
             enddo
             temp(ifp-iexp+1:j-iexp-1) = string(ifp+1:j-1)
             j = j-iexp
             iexp=0
             string(1:j-1) = temp(1:j-1)
           endif
           kdecp=index(string(1:j-1),'.')
           if(kdecp.eq.0) then
             kdecp=j
             if(pdecp_) then
               string(kdecp:kdecp)='.'
               j=j+1
             endif
           endif
           if(iexp.ne.0) then
             write(temp(1:5),'(i5)')iexp
             string(j:j)='E'
             j=j+1
             do ii=1,5
               c=temp(ii:ii)
               if(c.ne.' ') then
                 string(j:j)=c
                 j=j+1
               endif
             enddo
           endif
         endif
!
         if(j.lt.1) then
           string(1:1)='0'
           j=2
         endif
         if(kdecp.lt.1)kdecp=j
         if(pposdec_.ne.0) then
           pchar=lprefx+pposdec_-kdecp+1
         else
           if(pposval_.ne.0)pchar=lprefx+pposval_
         endif
         call tbxxpstr(string(1:j-1))
         return
         end
!
!
!
!
!
! >>>>>> Check dictionary for data name validation
!
         subroutine tbxxdck(name,type,flag,tflag)
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         logical    flag,tflag
         integer    nln
         character  name*(*),temp*(NUMCHAR),                            &
     &              type*4
!
         flag=.true.
         tflag=.true.
         nln = min(len(name),len(temp))
         call tbxxnlc(temp(1:nln),name)
         call hash_find(temp(1:nln),                                    &
     &     dicnam,dicchain,NUMDICT,ndict,dichash,NUMHASH,xdchk)
         if(xdchk.eq.0) goto 150
         if(tcheck.eq.'no ')          goto 200
         if(type.eq.dictyp(xdchk))    goto 200
         if(type.eq.'    ')           goto 200
         if(dictyp(xdchk).eq.'text' .and. type.eq.'char') goto 200
         if(dictyp(xdchk).eq.'char' .and. type.eq.'numb') goto 200
         tflag=.false.
         goto 200
150      flag=.false.
200      continue
         return
         end
!
!
!
!
!
! >>>>>> End of text string
!
         subroutine tbxxeot
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
!
         character*3 pqt
         integer pql
         integer lastnb

         pqt = pquote_
         pql = lastnb(pqt)
         if (pqt.eq.' ') pqt = ';'
         if (pqt.eq.'(') pqt = ')'
         if (pqt.eq.'{') pqt = '}'
         if (pqt.eq.'[') pqt = ']'

         if(ptextf.ne.'yes') then
           call tbxxwarn(' Out-of-sequence call to end text block')
           return
         endif
         ptextf='no '
         pchar=-1

         if (xmlout_) then
           if (pqt.eq.';') then
           call tbxxpstr(']]>')
           else
             call tbxxpstr(']]>'//pqt(1:pql))
           endif
           if (ploopn.gt.1) then
             call tbxxpxct(plhead(ploopc+1),plxhead(ploopc+1))
           endif
           if (ploopn.le.0) then
             call tbxxpxct(plhead(1),plxhead(1))
             plhead(1) = ' '
             plxhead(1) = ' '
           endif
         else
           call tbxxpstr(pqt(1:pql))
         endif
         if (pqt.eq.';') then
         call tbxxpstr(char(0))
         else
           call tbxxpstr(' ')
         endif
         return
         end
!
!
!
!
!
! >>>>>> End of bracketed structure detected;
!        close all open levels
!
         subroutine tbxxebkt
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         integer   i
         character*1 cd
         if (pdepth_ .eq. 0) return
         do i = 1,pdepth_
           cd = '}'
           if (pbrackstack(1+pdepth_-i).eq.'(' ) cd = ')'
           if (pbrackstack(1+pdepth_-i).eq.'[' ) cd = ']'
           pchar = max(pcharl,lprefx+pposbrkstk(1+pdepth_-i))
           call tbxxpstr(cd)
         end do
         pdepth_ = 0
         return
         end
!
!
!
!
!
! >>>>>> End of loop detected; check integrity and tidy up pointers
!
         subroutine tbxxelp
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         integer   i
!
         if(ploopn.eq.0)          goto 200
         if(ploopn.eq.-1) then
           if (xmlout_) then
             plcat = ' '
             plxcat = ' '
             plhead(1) = 'DUMMY'
             plxhead(1) = ' '
           else
             call tbxxpstr('_DUMMY')
           endif
           ploopn=1
           ploopc=0
           call tbxxwarn(                                               &
     &       ' Missing: missing loop_ name set as _DUMMY')
         endif
         if (xmlout_ .and. ploopn.eq.1 .and.                            &
     &     ploopf.ne.'yes') then
           call tbxxpxct(plhead(2),plxhead(2))
         endif
         if(ploopn.eq.ploopc)     goto 200
         do i=ploopc+1,ploopn
         if (xmlout_) then
           call tbxxpxot(plhead(i+1),plxhead(1+1))
           call tbxxpstr('DUMMY')
           call tbxxpxct(plhead(i+1),plxhead(i+1))
         else
           call tbxxpstr('DUMMY')
         endif
         enddo
         call tbxxwarn(                                                 &
     &         ' Missing: missing loop_ items set as DUMMY')
         plhead(1) = ' '
         plxhead(1) = ' '
!
200      ploopc=0
         ploopn=0
         if (xmlout_) then
           call tbxxpxct(plhead(1),plxhead(1))
           plhead(1) = ' '
           call tbxxpxct(plcat,plxcat)
           plcat = ' '
         endif
         return
         end
!
!
!
!
!
!
! >>>>>> Set common default values
!
         block data
!
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.sys 
!
!
! >>>>>> Common declararations 'ciftbx.sys'
!               
!        For inclusion in 'ciftbx.f'
!
!        Include all user common definitions, but not functions
!!! EXPANDING INCLUDE statement: ././RDINP/ciftbx.cmv 
!
! >>>>>> Common declararations 'ciftbx.cmn' (variables)
!
!        These declarations must be included in ciftbx user
!        applications.
!
!
!        Parameters to control sizes
!
!                                 Maximum number of characters in
!                                 data names
         integer NUMCHAR
         PARAMETER (NUMCHAR=75)
!                                 Maximum number of characters in
!                                 a line
         integer MAXBUF
         PARAMETER (MAXBUF=2048)
!
!                                 Alias use flag (true/false)
         logical   alias_
!                                 Alias output mapping flag (true/false)
         logical   aliaso_
!                                 Align loop active flag (true/false)
         logical   align_
!                                 Append next CIF to prior CIF (true/false)
         logical   append_
!                                 Clip first character of text on input (true/false)
         logical   clipt_
!                                 Found decimal point on numeric input (true/false)
         logical   decp_
!                                 Value validated
         logical   valid_
!                                 Folded text field (true/false)
         logical   fold_
!                                 Loop active flag (true/false)
         logical   loop_
!                                 Found leading zero on numeric input (true/false)
         logical   lzero_
!                                 GlobaL block active flag (true/false)
         logical   glob_
!                                 Global block output flag (true/false)
         logical   globo_
!                                 No blank string flag (true/false)
         logical   nblank_
!                                 No blank output string flag (true/false)
         logical   nblanko_
!                                 accept brackets
         logical   rdbkt_
!                                 accept braces
         logical   rdbrc_
!                                 accept parentheses
         logical   rdprn_
!                                 accept treble quotes
         logical   rdtq_
!                                 recognize closing quotes
         logical   rdrcqt_
!                                 accept colons as delimiters inside bracketed
!                                 constructs
         logical   rdcolon_
!                                 Clip first character of text on output (true/false)
         logical   pclipt_
!                                 Force decimal point on output (true/false)
         logical   pdecp_
!                                 Force leading zero on output (true/false)
         logical   plzero_
!                                 Output tab expansion flag (true/false)
         logical   ptabx_
!                                 Save frame active flag (true/false)
         logical   save_
!                                 Save frame output flag (true/false)
         logical   saveo_
!                                 Set loop tabs flag (true/false)
         logical   tabl_
!                                 Input tab expansion flag (true/false)
         logical   tabx_
!                                 Text active flag (true/false)
         logical   text_                                 
!                                 Unfold long input lines (true/false)
         logical   unfold_
!                                 Support xml style output
         logical   xmlout_
!                                 Support long xml names
         logical   xmlong_

!                                 Depth of current list, array, tuple or table
         integer   depth_
!                                 Index (from 1) in the list, array, tuple or table
         integer   index_
!                                 Length of current data item in strg_
         integer   long_
!                                 Loop block number of current item
         integer   list_
!                                 Length of current filename in file_
         integer   longf_
!                                 Integer limit on esd's (9, 19, 29, etc.)
         integer   esdlim_
!                                 Integer actual esd digits in input
         integer   esddig_
!                                 User setable input line value
         integer   line_
!                                 Depth of current list, array, tuple or table
         integer   pdepth_
!                                 Integer target esd digits in output
         integer   pesddig_
!                                 Character position of delimiter
         integer   posdelim_
!                                 Character position on which to fold output
         integer   pfold_
!                                 Character position of data name
         integer   posnam_
!                                 Character position of data value
         integer   posval_
!                                 Character position of decimal point
         integer   posdec_
!                                 Character position of end of field
         integer   posend_
!                                 Character position of delimiter
         integer   pposdelim_
!                                 Character position of output data name
         integer   pposnam_
!                                 Character position of output data value
         integer   pposval_
!                                 Character position of output decimal point
         integer   pposdec_
!                                 Character position of end of output field
         integer   pposend_
!                                 Record number of last last line
         integer   precn_
!                                 Record number of first input line to use
         integer   recbeg_
!                                 Record number of last input line to use
         integer   recend_
!                                 Record number of last input line in file
         integer   recn_

!                                 Name of current data block
         character bloc_*(NUMCHAR)
!                                 Data category
         character*(NUMCHAR) diccat_
!                                 Data alias root name or dictionary name
         character*(NUMCHAR) dicname_
!                                 Data parent name or dictionary name
         character*(NUMCHAR) dicpname_
!                                 Data type (May be more precise than type_)
         character*(NUMCHAR) dictype_
!                                 Dictionary version
         character*(NUMCHAR) dicver_
!                                 File name of current CIF
         character file_*(MAXBUF)
!                                 Quoted output string flag
         character pquote_*3
!                                 Quoted input string flag
         character quote_*3
!                                 Character image of current data item
         character strg_*(MAXBUF)
!                                 Input CIF tag name
         character*(NUMCHAR) tagname_
!                                 Version and date of CIFtbx
         character tbxver_*32
!                                 Data item type
         character type_*4
!                                 List, array, tuple or table item type
         character ttype_*4
!
         common/tbuc/ strg_,bloc_,file_,type_,ttype_,dictype_,diccat_,  &
     &     dicname_,dicpname_,dicver_,tagname_,quote_,pquote_,tbxver_
!
         common/tbui/ depth_,index_,list_,long_,longf_,line_,esdlim_,   &
     &     recn_,precn_,posnam_,posval_,posdec_,posend_,                &
     &     pposnam_,pposval_,pposdec_,pposend_,                         &
     &     recbeg_,recend_,esddig_,pdepth_,pesddig_,pfold_,             &
     &     posdelim_,pposdelim_
!
         common/tbul/ loop_,text_,align_,save_,saveo_,aliaso_,alias_,   &
     &     tabl_,tabx_,ptabx_,nblank_,nblanko_,glob_,globo_,decp_,      &
     &     pdecp_,lzero_,plzero_,append_,xmlout_,xmlong_,unfold_,       &
     &     fold_,valid_,clipt_,pclipt_,rdbrc_,rdbkt_,rdprn_,rdtq_,      &
     &     rdrcqt_, rdcolon_
!!! END OF : ././RDINP/ciftbx.cmv 
!
!        Define parameters controlling the sizes of things
!
         integer NUMDICT,NUMHASH,NUMBLOCK,NUMLOOP,NUMITEM,NUMCIP,       &
     &     NUMIP1,MAXTAB,MAXBOOK,NUMPAGE,NUMCPP,                        &
     &     XMLDEFS,XMLCHAR,MAXDEPTH,NUMIVALS,NUMCSTB,NUMSTB,            &
     &     NUMLP1,NUMSIP,NUMMIP
         character*1 XXFLAG
         integer XXRADIX
!
!                                 Flag character for RLE
         PARAMETER (XXFLAG='`')
!                                 Radix for RLE
         PARAMETER (XXRADIX=64)
!                                 Maximum number of tabs in output cif line
         PARAMETER (MAXTAB=10)
!                                 Maximum number of simultaneous bookmarks
         PARAMETER (MAXBOOK=1000)

!                                 Number of entries in data block tables
         PARAMETER (NUMBLOCK=2500)
!                                 Number of characters per page
         PARAMETER (NUMCPP=8192)
!                                 Number of characters per index pointer
         PARAMETER (NUMCIP=8)
!                                 Number of entries in dictionary tables
         PARAMETER (NUMDICT=11000)
!                                 Number of entries in item value range tables
         PARAMETER (NUMIVALS=16000)
!                                 Number of characters in a string table block
         PARAMETER (NUMCSTB=2048)
!                                 Number of blocks in the string table
         PARAMETER (NUMSTB=100)
!                                 Number of hash table entries (a modest prime)
         PARAMETER (NUMHASH=53)
!                                 Number of items in a loop
         PARAMETER (NUMITEM=50)
!                                 Derived value for loop arrays
         PARAMETER (NUMIP1=NUMITEM+1)


!                                 Derived master index values per page
         PARAMETER (NUMMIP=(NUMCPP/NUMCIP)-1)
!                                 Derived sub index values per page
         PARAMETER (NUMSIP=NUMCPP/NUMCIP)
!                                 Number of memory resident pages
         PARAMETER (NUMPAGE=200)
!                                 Number of loops in a data block
         PARAMETER (NUMLOOP=50)
!                                 Derived value for XML header
         PARAMETER (NUMLP1=NUMLOOP+1)
!

!                                 Number of XML translation definitions
         PARAMETER (XMLDEFS=500)
!                                 Maximum number of characters per definition
         PARAMETER (XMLCHAR=60)
!                                 Maximum depth for a list, array, tuple or table
         PARAMETER (MAXDEPTH=20)
         
!                                 Reverse solidus
         character*2 rsolidus
!                                 Stack of list, array, tuple or table types
         character*4 typestack(MAXDEPTH)
!                                 Stack of actual bracket characters on read
         character*1 brackstack(MAXDEPTH)
!                                 Stack of actual bracket characters on write
         character*1 pbrackstack(MAXDEPTH)
!                                 Stack of actual bracket character pos on read
         integer posbrkstk(MAXDEPTH)
!                                 Stack of actual bracket character pos on write
         integer pposbrkstk(MAXDEPTH)
!                                 Stack of delimiters before current item on read
         character*1 delimstack(MAXDEPTH+1)
!                                 Stack of delimiters before current item on write
         character*1 pdelimstack(MAXDEPTH+1)
!                                 Stack of positions of delimiters on read
         integer posdlmstk(MAXDEPTH+1)
!                                 Stack of record number of delimiters on read
         integer recdlmstk(MAXDEPTH+1)
!                                 Stack of positions of delimiters on write
         integer pposdlmstk(MAXDEPTH+1)
!                                 Stack of linear positions in list, array, tuple or table
         integer indexstack(MAXDEPTH)
!                                 Stack of state of scan for list, arry, tuple or table
!                                 0 - scan not started
!                                 1 - scan has encountered the opening tag and stored
!                                     it in brackstack(depth_)
!                                 2 - scan has encountered a value, or one of , ( { [
         integer statestack(MAXDEPTH)
!                                 Stack of state of write for list, arry, tuple or table
!                                 1 - just emitted { [ ( or , 
!                                 2 - just emitted a value
         integer pstatestack(MAXDEPTH)
!                                 Table of xml translations
         character*(XMLCHAR) xmlate(XMLDEFS)
!                                 Memory resident page buffer
         character*(NUMCPP) pagebuf(NUMPAGE)
!                                 Scratch page buffer
         character*(NUMCPP) scrbuf
!                                 Name of current data item
         character nametb*(NUMCHAR)
!                                 Tab character for this machine
         character tab*1
!                                 Character buffer for reading lines
         character buffer*(MAXBUF)
!                                 Character buffer for tab-expanded lines
         character bufntb*(MAXBUF)
!                                 Dictionary validation check
         character vcheck*3
!                                 Dictionary category check flag
         character catchk*3
!                                 Dictionary parent check flag
         character parchk*3
!                                 Dictionary flag             
         character dictfl*3
!                                 Dictionary names
         character*(NUMCHAR) dicnam(NUMDICT)
!                                 Dictionary names with upper/lower case
         character*(NUMCHAR) dictag(NUMDICT)
!                                 Dictionary data types
         character dictyp(NUMDICT)*4
!                                 Data names in data block
         character*(NUMCHAR) dname(NUMBLOCK)
!                                 Data names in data block with u/l case
         character*(NUMCHAR) dtag(NUMBLOCK)
!                                 Data type of data item 
         character dtype(NUMBLOCK)*4
!                                 Format for single precision esd's
         character*13 esdfmt
!                                 Format for double precision esd's
         character*13 edpfmt
!                                 Category names in use
         character*(NUMCHAR) cname(NUMBLOCK)
!                                 Dictionary category names
         character*(NUMCHAR) dcname(NUMDICT)
!                                 Dictionary extended types
         character*(NUMCHAR) dicxtyp(NUMDICT)
!                                 Datablock extended types
         character*(NUMCHAR) dxtyp(NUMBLOCK)
!                                 Format for writing double precision numbers
         character*8 ndpfmt       
!                                 Output string buffer
         character obuf*(MAXBUF)
!                                 Data block name of the current block
         character pdblok*(NUMCHAR)
!                                 Category of the current loop
         character plcat*(NUMCHAR)
!                                 Tags in the current loop header
         character*(NUMCHAR) plhead(NUMLP1)
!                                 Category of the current loop, translated
         character plxcat*(NUMCHAR)
!                                 Tags in the current loop header, translated
         character*(NUMCHAR) plxhead(NUMLP1)
!                                 Flag signalling output CIF open
         character pfilef*3
!                                 Flag signalling loop_ being loaded
         character ploopf*3
!                                 Flag signalling text being loaded
         character ptextf*3
!                                 Output prefix string
         character prefx*(MAXBUF)
!                                 Dictionary data type check
         character tcheck*3
!                                 Flag if test_ last called (yes/no )
         character testfl*3
!                                 Flag if the text_ field is folded
         character textfl*3
!                                 String table
         character*(NUMCSTB) stable(NUMSTB)
!                                 Pointers to xml translations for categories
         integer   xmcind(NUMBLOCK)
!
!        Variables for management of direct acccess file paging
!
!                                 Next free block
         integer   nfblock
!                                 Next free word (NUMCIP chars)
         integer   nfword
!                                 Master index pointer buffer
         integer   mippoint(NUMMIP)
!                                 Subindex pointer buffer
         integer   ippoint(NUMSIP)
!                                 Master index chain pointer
         integer   mipcp
!                                 Master index page in memory
         integer   mipim
!                                 Master index record in memory
         integer   miprim
!                                 Sub index page in memory
         integer   ipim
!                                 Sub index record in memory
         integer   iprim
!                                 Pointers to memory resident pages
         integer   mppoint(NUMPAGE)
!
!                                 Record number containing data item
         integer   drecd(NUMBLOCK)
!                                 Character position of item in record
         integer   dchar(NUMBLOCK)
!                                 Record number containing tag of item
         integer   trecd(NUMBLOCK)
!                                 Character position of tag of item in record
         integer   tchar(NUMBLOCK)
!                                 Character position of tag of item in record
!                                 tab-expanded
         integer   xchar(NUMBLOCK)
!                                 Loop block number (0 for non-loop)
         integer   nloop(NUMBLOCK)
!                                 Item count in loop packet
         integer   iloop(NUMBLOCK)
!                                 Loop line counter; initially zero
         integer   lloop(NUMBLOCK)
!                                 Number of items per packet in each loop
         integer   loopni(NUMLOOP)
!                                 Number of packets per loop    
         integer   loopnp(NUMLOOP)
!                                 Record number of loop header    
         integer   loorec(NUMLOOP)
!                                 Character position of loop header    
         integer   loopos(NUMLOOP)
!                                 Character position of loop header
!                                 tab-expanded    
         integer   loopox(NUMLOOP)
!                                 Number of last non-blank chars in input 
         integer   lastch
!                                 Number of items in current loop packet
         integer   ploopc
!                                 Number of items in output loop packet
         integer   ploopn
!                                 Number of current loop block
         integer   loopnl
!                                 Count of packets in current loop
         integer   loopct
!                                 Length of nametb
         integer   lnametb
!                                 Number of data names in hash table 
         integer   nhash 
!                                 Number of data names in data block
         integer   nname
!                                 Current number of data name in block
         integer   iname
!                                 Number of dictionary names
         integer   ndict 
!                                 Number of records in CIF
         integer   nrecd
!                                 Record number of requested line
         integer   irecd
!                                 Record number of current line
         integer   jrecd
!                                 Record number of tab-expanded line
         integer   jrect
!                                 Last record number of current block
         integer   lrecd
!                                 Record no. of start of bracketed construct
         integer   srecd
!                                 Character pointer of current input line
         integer   jchar
!                                 Character pointer of output CIF line
!                                 next location to store
         integer   pchar
!                                 Character pointer of output CIF line
!                                 last location stored
         integer   pcharl
!                                 Number of data block names stored
         integer   nbloc
!                                 Device number of input CIF 
         integer   cifdev
!                                 Device number of direct access file
         integer   dirdev
!                                 Device number of error message file
         integer   errdev
!                                 Device number of output CIF
         integer   outdev
!                                 Cached copy of esdlim_
         integer   esdcac
!                                 Cached esd digits
         integer   esddigx
!                                 Number of Dictionary Category names stored
         integer   ndcname
!                                 Bookmark data
         integer   ibkmrk(6,MAXBOOK)
!                                 Indices of XML translations for
!                                 items
         integer   xmindex(NUMDICT)
!                                 Dictionary category name indices
         integer   dcindex(NUMDICT)
!                                 Dictionary value enumerations list index       
         integer   deindex(NUMDICT)
!                                 Dictionary parent name indices
         integer   dpindex(NUMDICT)
!                                 Dictionary mandatory code (-1,0,1 implicit,no,yes) 
         integer   dmcode(NUMDICT)
!                                 Hash Table for Dic. Category names
         integer   dchash(NUMHASH)
!                                 Chain pointers for hash searches
!                                 of Dictionary Category names
         integer   dcchain(NUMDICT)
!                                 Hash table for Dictionary name
         integer   dichash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 Dictionary names
         integer   dicchain(NUMDICT)
!                                 Block hash table
         integer   dhash(NUMHASH)
!                                 Category hash table
         integer   chash(NUMHASH)
!                                 Chain pointers for hash search of
!                                 block names
         integer   dchain(NUMBLOCK)
!                                 Chain pointers for hash search of
!                                 categories
         integer   cchain(NUMBLOCK)
!                                 Number of xml translations stored
         integer   xmnxlat
!                                 Number of Category names stored
         integer   ncname
!                                 Character starting position of loop items
         integer   loopch(NUMIP1)
!                                 String length of loop items
         integer   loopln(NUMIP1)
!                                 Record number of loop items
         integer   looprd(NUMIP1)
!                                 Indices of Category 
!                                 names for items
         integer   cindex(NUMBLOCK)
!                                 Dictionary pointer from data block
         integer   ddict(NUMBLOCK)
!                                 Alias links, 0 for no alias or index
!                                 of item name in dicnam which
!                                 is the root of its definitions
         integer   aroot(NUMDICT)
!                                 Alias links, 0 for no next alias or
!                                 index of next alias in dicnam
         integer   alias(NUMDICT)
!                                 dcheck result from dicnam
         integer   xdchk
!                                 minimum exponent for DP calculations
         integer   minexp
!                                 length of output prefix string
         integer   lprefx
!                                 Potential tabs in output line
         integer   itabp(MAXTAB)
!                                 Count of potential tabs
         integer   numtab
!                                 Pointer to xml DATA_ translation
         integer   xmdata
!                                 Returned number
         double precision numbtb
!                                 Returned standard deviation
         double precision sdevtb
!                                 Decimal double precision precision
         double precision dpprc
!                                 Decimal double precision minimum power of 10
         double precision dpmin
!                                 Decimal single precision precision
         real      decprc
!                                 Decimal single precision minimum power of 10
         real      decmin
!                                 Internal result save
         logical   tbxxrslt
!                                 Internal save of saveo_
         logical   psaveo
!                                 Flag for tag being a category key (DDL2) or
!                                 list_reference (DDL1)
         logical   catkey(NUMDICT)
!                                 Internal result save
         integer   tbxxintr
!                                 category pointers to keys
         integer   ccatkey(NUMDICT)
!                                 linked list of multiple keys
         integer   keychain(NUMDICT)
!                                 nstable -- number of characters on stable
         integer   nstable
!                                 item value range table
!                                   nivt   -- number of items in item value table
         integer   nivt
!                                   ivtnxt -- next relevant entry
         integer   ivtnxt(NUMIVALS)
!                                   ivtvet -  value enumeration type
!                                             -1 closed range
!                                              0 value
!                                              1 open range
         integer   ivtvet(NUMIVALS)
!                                   ivtsbp -  string buffer pointer for value
         integer   ivtsbp(NUMIVALS)
!
         common/tbxc/ buffer,dname,dtype,tab,dicnam,dictag,dictyp

         common/tbxc1/ dictfl,nametb
         
         common/tbxc2/ dtag

         common/tbxc3/ testfl,vcheck,tcheck,pfilef               

         common/tbxc4/ pagebuf, scrbuf

         common/tbxc5/ ploopf,ptextf

         common/tbxc6/ dcname

         common/tbxc7/ cname

         common/tbxc8/ dicxtyp

         common/tbxc9/ dxtyp

         common/tbxc10/ esdfmt,edpfmt,ndpfmt,prefx
 
         common/tbxc11/ obuf,bufntb,catchk,parchk,plcat,pdblok,plhead

         common/tbxc12/ xmlate,plxcat,plxhead,textfl
         
         common/tbxc13/ stable
         
         common/tbxc14/ rsolidus
         
         common/tbxc15 /brackstack,pbrackstack,delimstack,pdelimstack,  &
     &                  typestack
!
         common/tbxi/ nrecd,drecd,trecd,irecd,lrecd,dchar,tchar,xchar,  &
     &                ndict,outdev,nloop,iloop,lloop,loopct,loopni,     &
     &                loopnp,loopnl,nname,nhash,cifdev,dirdev,errdev,   &
     &                jchar,pchar,iname,ploopn,ploopc,nbloc,jrecd,      &
     &                lastch,esdcac,esddigx,ndcname,dcindex,ncname,     &
     &                cindex,aroot,alias,dchash,dcchain,dichash,        &
     &                srecd,tbxxintr

         common/tbxi1/ dicchain,dhash,dchain,ddict,xdchk,loopln,        &
     &                looprd,minexp,lprefx,numtab,pcharl,loopos,        &
     &                loopox,loorec,jrect,ibkmrk,chash,cchain,mppoint,  &
     &                keychain,ccatkey,statestack,pstatestack,          &
     &                indexstack,posdlmstk,pposdlmstk,posbrkstk,        &
     &                pposbrkstk,recdlmstk

         common/tbxi2/ mippoint,ippoint,xmcind,xmnxlat,xmdata,nfblock,  &
     &                nfword,mipcp,mipim,miprim,ipim,iprim,xmindex,     &
     &                lnametb
         common/tbxi3/ dpindex,deindex,nstable,nivt,ivtnxt,ivtvet,      &
     &                ivtsbp,dmcode
         common/tbxi4/ itabp
         common/tbxi5/ loopch

!
         common/tbxdp/numbtb,sdevtb,dpprc,dpmin
!
         common/tbxr/ decprc,decmin
!
         common/tbxl/ catkey,psaveo,tbxxrslt
!
!!! END OF : ././RDINP/ciftbx.sys 
         data cifdev     /1/
         data outdev     /2/
         data dirdev     /3/
         data errdev     /6/
         data recbeg_    /1/
         data recend_    /0/
         data loopct     /0/
         data nhash      /0/
         data ndict      /0/
         data nname      /0/
         data nbloc      /0/
         data ploopn     /0/
         data ploopc     /0/
         data xmnxlat    /0/
         data xmdata     /0/
         data rsolidus   /'\\'/
         data ploopf     /'no '/
         data ptextf     /'no '/
         data pfilef     /'no '/
         data testfl     /'no '/
         data textfl     /'no '/
         data vcheck     /'no '/
         data tcheck     /'no '/
         data catchk     /'yes'/
         data parchk     /'yes'/
         data align_     /.true./
         data append_    /.false./
         data tabl_      /.true./
         data tabx_      /.true./
         data ptabx_     /.true./
         data text_      /.false./
         data loop_      /.false./
         data ndcname    /0/
         data ncname     /0/
         data rdprn_     /.false./
         data rdbrc_     /.false./
         data rdbkt_     /.false./
         data rdtq_      /.false./
         data rdrcqt_    /.false./
         data rdcolon_   /.false./
         data save_      /.false./
         data saveo_     /.false./
         data psaveo     /.false./
         data glob_      /.false./
         data globo_     /.false./
         data alias_     /.true./
         data aliaso_    /.false./
         data nblank_    /.false./
         data nblanko_   /.false./
         data decp_      /.false./
         data pdecp_     /.false./
         data lzero_     /.false./
         data plzero_    /.false./
         data xmlout_    /.false./
         data catkey     /NUMDICT*.false./
         data xmlong_    /.true./
         data dchash     /NUMHASH*0/
         data dichash    /NUMHASH*0/
         data dhash      /NUMHASH*0/
         data dcchain    /NUMDICT*0/
         data aroot      /NUMDICT*0/
         data keychain   /NUMDICT*0/
         data ccatkey    /NUMDICT*0/
         data cindex     /NUMBLOCK*0/
         data deindex    /NUMDICT*0/
         data dcindex    /NUMDICT*0/
         data line_      /80/
         data lastch     /0/
         data dictype_   /' '/
         data dicname_   /' '/
         data dicver_    /' '/
         data diccat_    /' '/
         data tagname_   /' '/
         data plcat      /' '/
         data plhead     /NUMLP1*' '/
         data prefx      /' '/
         data file_      /' '/
         data longf_     /1/
         data tbxver_    /'CIFtbx version 4.1.0 29 Nov 2009'/
         data lprefx     /0/
         data esdlim_    /19/
         data esddig_    /0/
         data pesddig_   /0/
         data esdcac     /19/
         data esddigx    /2/
         data esdfmt     /'(e12.2)'/
         data edpfmt     /'(d12.2)'/
         data ndpfmt     /'(d30.14)'/
         data decprc     /1.e-6/
         data dpprc      /1.d-14/
         data decmin     /1.e-37/
         data dpmin      /1.d-307/
         data minexp     /-307/
         data itabp      /MAXTAB*0/
         data jrect      /-1/
         data numtab     /0/
         data recn_      /0/
         data precn_     /0/
         data posnam_    /0/
         data posval_    /0/
         data posdec_    /0/
         data posend_    /0/
         data pposnam_   /0/
         data pposval_   /0/
         data pposdec_   /0/
         data pposend_   /0/
         data quote_     /' '/
         data pquote_    /' '/
         data unfold_    /.false./
         data fold_      /.false./
         data clipt_     /.true./
         data pclipt_    /.true./
         data pfold_     /0/
         data ibkmrk     /MAXBOOK*-1,MAXBOOK*-1,                        &
     &                    MAXBOOK*-1,MAXBOOK*-1,                        &
     &                    MAXBOOK*-1,MAXBOOK*-1/
         data lnametb    /1/
         data nametb     /' '/

         end
!
!
!       change the following include to include 'clearfp_sun.f'
!       for use on a SUN
!
!        include 'clearfp.f90'


 subroutine findz(elem,z)
! This routine simply translates the element name into the atomic number.
   implicit none
   character*2,intent(in) :: elem
   integer,intent(out) :: z
   
   
	 z=-1
     if (elem.eq.'Ac') z= 89 
     if (elem.eq.'Ag') z= 47 
     if (elem.eq.'Al') z= 13 
     if (elem.eq.'Am') z= 95 
     if (elem.eq.'Ar') z= 18 
     if (elem.eq.'As') z= 33 
     if (elem.eq.'At') z= 85 
     if (elem.eq.'Au') z= 79 
     if (elem.eq.'B ') z=  5
     if (elem.eq.'Ba') z= 56 
     if (elem.eq.'Be') z=  4 
     if (elem.eq.'Bi') z= 83 
     if (elem.eq.'Bk') z= 97 
     if (elem.eq.'Br') z= 35 
     if (elem.eq.'C ') z=  6 
     if (elem.eq.'Ca') z= 20 
     if (elem.eq.'Cd') z= 48 
     if (elem.eq.'Ce') z= 58 
     if (elem.eq.'Cf') z= 98 
     if (elem.eq.'Cl') z= 17 
     if (elem.eq.'Cm') z= 96 
     if (elem.eq.'Co') z= 27 
     if (elem.eq.'Cr') z= 24 
     if (elem.eq.'Cs') z= 55 
     if (elem.eq.'Cu') z= 29 
     if (elem.eq.'Dy') z= 66 
     if (elem.eq.'Er') z= 68 
     if (elem.eq.'Es') z= 99 
     if (elem.eq.'Eu') z= 63 
     if (elem.eq.'F')  z=  9 
     if (elem.eq.'Fe') z= 26 
     if (elem.eq.'Fm') z=100 
     if (elem.eq.'Fr') z= 87 
     if (elem.eq.'Ga') z= 31 
     if (elem.eq.'Gd') z= 64 
     if (elem.eq.'Ge') z= 32 
     if (elem.eq.'H '.OR.elem.eq.'D ') z=  1 
     if (elem.eq.'He') z=  2 
     if (elem.eq.'Hf') z= 72 
     if (elem.eq.'Hg') z= 80 
     if (elem.eq.'Ho') z= 67 
     if (elem.eq.'I ') z= 53 
     if (elem.eq.'In') z= 49 
     if (elem.eq.'Ir') z= 77 
     if (elem.eq.'K ') z= 19 
     if (elem.eq.'Kr') z= 36 
     if (elem.eq.'La') z= 57 
     if (elem.eq.'Li') z=  3 
     if (elem.eq.'Lr') z=103 
     if (elem.eq.'Lu') z= 71 
     if (elem.eq.'Md') z=101 
     if (elem.eq.'Mg') z= 12 
     if (elem.eq.'Mn') z= 25 
     if (elem.eq.'Mo') z= 42 
     if (elem.eq.'N ') z=  7 
     if (elem.eq.'Na') z= 11 
     if (elem.eq.'Nb') z= 41 
     if (elem.eq.'Nd') z= 60 
     if (elem.eq.'Ne') z= 10 
     if (elem.eq.'Ni') z= 28 
     if (elem.eq.'No') z=102 
     if (elem.eq.'Np') z= 93 
     if (elem.eq.'O ') z=  8 
     if (elem.eq.'Os') z= 76 
     if (elem.eq.'P ') z= 15 
     if (elem.eq.'Pa') z= 91 
     if (elem.eq.'Pb') z= 82 
     if (elem.eq.'Pd') z= 46 
     if (elem.eq.'Pm') z= 61 
     if (elem.eq.'Po') z= 84 
     if (elem.eq.'Pr') z= 59 
     if (elem.eq.'Pt') z= 78 
     if (elem.eq.'Pu') z= 94 
     if (elem.eq.'Ra') z= 88 
     if (elem.eq.'Rb') z= 37 
     if (elem.eq.'Re') z= 75 
     if (elem.eq.'Rh') z= 45 
     if (elem.eq.'Rn') z= 86 
     if (elem.eq.'Ru') z= 44 
     if (elem.eq.'S ') z= 16 
     if (elem.eq.'Sb') z= 51 
     if (elem.eq.'Sc') z= 21 
     if (elem.eq.'Se') z= 34 
     if (elem.eq.'Si') z= 14 
     if (elem.eq.'Sm') z= 62 
     if (elem.eq.'Sn') z= 50 
     if (elem.eq.'Sr') z= 38 
     if (elem.eq.'Ta') z= 73 
     if (elem.eq.'Tb') z= 65 
     if (elem.eq.'Tc') z= 43 
     if (elem.eq.'Te') z= 52 
     if (elem.eq.'Th') z= 90 
     if (elem.eq.'Ti') z= 22 
     if (elem.eq.'Tl') z= 81 
     if (elem.eq.'Tm') z= 69 
     if (elem.eq.'U ') z= 92
     if (elem.eq.'V ') z= 23 
     if (elem.eq.'W ') z= 74 
     if (elem.eq.'Xe') z= 54 
     if (elem.eq.'Y ') z= 39 
     if (elem.eq.'Yb') z= 70 
     if (elem.eq.'Zn') z= 30 
     if (elem.eq.'Zr') z= 40 

     if (z.lt.0) stop 'unknown element specified'

end subroutine findz

 subroutine getlattype(sgname, lattyp)
! This routine gives the Bravais lattice type for a given spacegroup.
     implicit none
	 character*3,intent(out) :: lattyp
	 character*8,intent(inout) :: sgname
	 integer i

!    Correct for spellings like 'C2/C' which should be 'C2/c'
     do i=2,8
	    if (sgname(i:i).eq.'M') sgname(i:i)='m'
	    if (sgname(i:i).eq.'A') sgname(i:i)='a'
	    if (sgname(i:i).eq.'B') sgname(i:i)='b'
	    if (sgname(i:i).eq.'C') sgname(i:i)='c'
	 enddo
	 
     lattyp='   '
     if (sgname.eq.'P1      ') lattyp='P  '
     if (sgname.eq.'P-1     ') lattyp='P  '
     if (sgname.eq.'P2      ') lattyp='P  '
     if (sgname.eq.'P2      ') lattyp='P  '
     if (sgname.eq.'P2      ') lattyp='P  '
     if (sgname.eq.'P21     ') lattyp='P  '
     if (sgname.eq.'P21     ') lattyp='P  '
     if (sgname.eq.'P21     ') lattyp='P  '
     if (sgname.eq.'C2      ') lattyp='CXY'
     if (sgname.eq.'A2      ') lattyp='CYZ'
     if (sgname.eq.'B2      ') lattyp='CXZ'
     if (sgname.eq.'B2      ') lattyp='CXZ'
     if (sgname.eq.'C2      ') lattyp='CXY'
     if (sgname.eq.'A2      ') lattyp='CYZ'
     if (sgname.eq.'Pm      ') lattyp='P  '
     if (sgname.eq.'Pm      ') lattyp='P  '
     if (sgname.eq.'Pm      ') lattyp='P  '
     if (sgname.eq.'Pc      ') lattyp='P  '
     if (sgname.eq.'Pa      ') lattyp='P  '
     if (sgname.eq.'Pb      ') lattyp='P  '
     if (sgname.eq.'Pb      ') lattyp='P  '
     if (sgname.eq.'Pc      ') lattyp='P  '
     if (sgname.eq.'Pa      ') lattyp='P  '
     if (sgname.eq.'Pn      ') lattyp='P  '
     if (sgname.eq.'Pn      ') lattyp='P  '
     if (sgname.eq.'Pn      ') lattyp='P  '
     if (sgname.eq.'Cm      ') lattyp='CXY'
     if (sgname.eq.'Am      ') lattyp='CYZ'
     if (sgname.eq.'Bm      ') lattyp='CXZ'
     if (sgname.eq.'Bm      ') lattyp='CXZ'
     if (sgname.eq.'Cm      ') lattyp='CXY'
     if (sgname.eq.'Am      ') lattyp='CYZ'
     if (sgname.eq.'Cc      ') lattyp='CXY'
     if (sgname.eq.'Aa      ') lattyp='CYZ'
     if (sgname.eq.'Bb      ') lattyp='CXZ'
     if (sgname.eq.'Bb      ') lattyp='CXZ'
     if (sgname.eq.'Cc      ') lattyp='CXY'
     if (sgname.eq.'Aa      ') lattyp='CYZ'
     if (sgname.eq.'P2/m    ') lattyp='P  '
     if (sgname.eq.'P2/m    ') lattyp='P  '
     if (sgname.eq.'P2/m    ') lattyp='P  '
     if (sgname.eq.'P21/m   ') lattyp='P  '
     if (sgname.eq.'P21/m   ') lattyp='P  '
     if (sgname.eq.'P21/m   ') lattyp='P  '
     if (sgname.eq.'C2/m    ') lattyp='CXY'
     if (sgname.eq.'A2/m    ') lattyp='CYZ'
     if (sgname.eq.'B2/m    ') lattyp='CXZ'
     if (sgname.eq.'B2/m    ') lattyp='CXZ'
     if (sgname.eq.'C2/m    ') lattyp='CXY'
     if (sgname.eq.'A2/m    ') lattyp='CYZ'
     if (sgname.eq.'P2/c    ') lattyp='P  '
     if (sgname.eq.'P2/a    ') lattyp='P  '
     if (sgname.eq.'P2/b    ') lattyp='P  '
     if (sgname.eq.'P2/b    ') lattyp='P  '
     if (sgname.eq.'P2/c    ') lattyp='P  '
     if (sgname.eq.'P2/a    ') lattyp='P  '
     if (sgname.eq.'P2/n    ') lattyp='P  '
     if (sgname.eq.'P2/n    ') lattyp='P  '
     if (sgname.eq.'P2/n    ') lattyp='P  '
     if (sgname.eq.'P21/c   ') lattyp='P  '
     if (sgname.eq.'P21/a   ') lattyp='P  '
     if (sgname.eq.'P21/b   ') lattyp='P  '
     if (sgname.eq.'P21/b   ') lattyp='P  '
     if (sgname.eq.'P21/c   ') lattyp='P  '
     if (sgname.eq.'P21/a   ') lattyp='P  '
     if (sgname.eq.'P21/n   ') lattyp='P  '
     if (sgname.eq.'P21/n   ') lattyp='P  '
     if (sgname.eq.'P21/n   ') lattyp='P  '
     if (sgname.eq.'C2/c    ') lattyp='CXY'
     if (sgname.eq.'A2/a    ') lattyp='CYZ'
     if (sgname.eq.'B2/b    ') lattyp='CXZ'
     if (sgname.eq.'B2/b    ') lattyp='CXZ'
     if (sgname.eq.'C2/c    ') lattyp='CXY'
     if (sgname.eq.'A2/a    ') lattyp='CYZ'
     if (sgname.eq.'P222    ') lattyp='P  '
     if (sgname.eq.'P2221   ') lattyp='P  '
     if (sgname.eq.'P2122   ') lattyp='P  '
     if (sgname.eq.'P2212   ') lattyp='P  '
     if (sgname.eq.'P21212  ') lattyp='P  '
     if (sgname.eq.'P22121  ') lattyp='P  '
     if (sgname.eq.'P21221  ') lattyp='P  '
     if (sgname.eq.'P212121 ') lattyp='P  '
     if (sgname.eq.'C2221   ') lattyp='CXY'
     if (sgname.eq.'A2122   ') lattyp='CYZ'
     if (sgname.eq.'B2212   ') lattyp='CXZ'
     if (sgname.eq.'C222    ') lattyp='CXY'
     if (sgname.eq.'A222    ') lattyp='CYZ'
     if (sgname.eq.'B222    ') lattyp='CXZ'
     if (sgname.eq.'F222    ') lattyp='F  '
     if (sgname.eq.'I222    ') lattyp='B  '
     if (sgname.eq.'I212121 ') lattyp='B  '
     if (sgname.eq.'Pmm2    ') lattyp='P  '
     if (sgname.eq.'P2mm    ') lattyp='P  '
     if (sgname.eq.'Pm2m    ') lattyp='P  '
     if (sgname.eq.'Pmc21   ') lattyp='P  '
     if (sgname.eq.'P21ma   ') lattyp='P  '
     if (sgname.eq.'Pb21m   ') lattyp='P  '
     if (sgname.eq.'Pcm21   ') lattyp='P  '
     if (sgname.eq.'P21am   ') lattyp='P  '
     if (sgname.eq.'Pm21b   ') lattyp='P  '
     if (sgname.eq.'Pcc2    ') lattyp='P  '
     if (sgname.eq.'P2aa    ') lattyp='P  '
     if (sgname.eq.'Pb2b    ') lattyp='P  '
     if (sgname.eq.'Pma2    ') lattyp='P  '
     if (sgname.eq.'P2mb    ') lattyp='P  '
     if (sgname.eq.'Pc2m    ') lattyp='P  '
     if (sgname.eq.'Pbm2    ') lattyp='P  '
     if (sgname.eq.'P2cm    ') lattyp='P  '
     if (sgname.eq.'Pm2a    ') lattyp='P  '
     if (sgname.eq.'Pca21   ') lattyp='P  '
     if (sgname.eq.'P21ab   ') lattyp='P  '
     if (sgname.eq.'Pc21b   ') lattyp='P  '
     if (sgname.eq.'Pbc21   ') lattyp='P  '
     if (sgname.eq.'P21ca   ') lattyp='P  '
     if (sgname.eq.'Pb21a   ') lattyp='P  '
     if (sgname.eq.'Pnc2    ') lattyp='P  '
     if (sgname.eq.'P2na    ') lattyp='P  '
     if (sgname.eq.'Pb2n    ') lattyp='P  '
     if (sgname.eq.'Pcn2    ') lattyp='P  '
     if (sgname.eq.'P2an    ') lattyp='P  '
     if (sgname.eq.'Pn2b    ') lattyp='P  '
     if (sgname.eq.'Pmn21   ') lattyp='P  '
     if (sgname.eq.'P21mn   ') lattyp='P  '
     if (sgname.eq.'Pn21m   ') lattyp='P  '
     if (sgname.eq.'Pnm21   ') lattyp='P  '
     if (sgname.eq.'P21nm   ') lattyp='P  '
     if (sgname.eq.'Pm21n   ') lattyp='P  '
     if (sgname.eq.'Pba2    ') lattyp='P  '
     if (sgname.eq.'P2cb    ') lattyp='P  '
     if (sgname.eq.'Pc2a    ') lattyp='P  '
     if (sgname.eq.'Pna21   ') lattyp='P  '
     if (sgname.eq.'P21nb   ') lattyp='P  '
     if (sgname.eq.'Pc21n   ') lattyp='P  '
     if (sgname.eq.'Pbn21   ') lattyp='P  '
     if (sgname.eq.'P21cn   ') lattyp='P  '
     if (sgname.eq.'Pn21a   ') lattyp='P  '
     if (sgname.eq.'Pnn2    ') lattyp='P  '
     if (sgname.eq.'P2nn    ') lattyp='P  '
     if (sgname.eq.'Pn2n    ') lattyp='P  '
     if (sgname.eq.'Cmm2    ') lattyp='CXY'
     if (sgname.eq.'A2mm    ') lattyp='CYZ'
     if (sgname.eq.'Bm2m    ') lattyp='CXZ'
     if (sgname.eq.'Cmc21   ') lattyp='CXY'
     if (sgname.eq.'A21ma   ') lattyp='CYZ'
     if (sgname.eq.'Bb21m   ') lattyp='CXZ'
     if (sgname.eq.'Ccm21   ') lattyp='CXY'
     if (sgname.eq.'A21am   ') lattyp='CYZ'
     if (sgname.eq.'Bm21b   ') lattyp='CXZ'
     if (sgname.eq.'Ccc2    ') lattyp='CXY'
     if (sgname.eq.'A2aa    ') lattyp='CYZ'
     if (sgname.eq.'Bb2b    ') lattyp='CXZ'
     if (sgname.eq.'Amm2    ') lattyp='CYZ'
     if (sgname.eq.'B2mm    ') lattyp='CXZ'
     if (sgname.eq.'Cm2m    ') lattyp='CXY'
     if (sgname.eq.'Abm2    ') lattyp='CYZ'
     if (sgname.eq.'B2cm    ') lattyp='CXZ'
     if (sgname.eq.'Cm2a    ') lattyp='CXY'
     if (sgname.eq.'Bma2    ') lattyp='CXZ'
     if (sgname.eq.'C2mb    ') lattyp='CXY'
     if (sgname.eq.'Ac2m    ') lattyp='CYZ'
     if (sgname.eq.'Ama2    ') lattyp='CYZ'
     if (sgname.eq.'B2mb    ') lattyp='CXZ'
     if (sgname.eq.'Cc2m    ') lattyp='CXY'
     if (sgname.eq.'Bbm2    ') lattyp='CXZ'
     if (sgname.eq.'C2cm    ') lattyp='CXY'
     if (sgname.eq.'Am2a    ') lattyp='CYZ'
     if (sgname.eq.'Aba2    ') lattyp='CYZ'
     if (sgname.eq.'B2cb    ') lattyp='CXZ'
     if (sgname.eq.'Cc2a    ') lattyp='CXY'
     if (sgname.eq.'Bba2    ') lattyp='CXZ'
     if (sgname.eq.'C2cb    ') lattyp='CXY'
     if (sgname.eq.'Ac2a    ') lattyp='CYZ'
     if (sgname.eq.'Fmm2    ') lattyp='F  '
     if (sgname.eq.'F2mm    ') lattyp='F  '
     if (sgname.eq.'Fm2m    ') lattyp='F  '
     if (sgname.eq.'Fdd2    ') lattyp='F  '
     if (sgname.eq.'F2dd    ') lattyp='F  '
     if (sgname.eq.'Fd2d    ') lattyp='F  '
     if (sgname.eq.'Imm2    ') lattyp='B  '
     if (sgname.eq.'I2mm    ') lattyp='B  '
     if (sgname.eq.'Im2m    ') lattyp='B  '
     if (sgname.eq.'Iba2    ') lattyp='B  '
     if (sgname.eq.'I2cb    ') lattyp='B  '
     if (sgname.eq.'Ic2a    ') lattyp='B  '
     if (sgname.eq.'Ima2    ') lattyp='B  '
     if (sgname.eq.'I2mb    ') lattyp='B  '
     if (sgname.eq.'Ic2m    ') lattyp='B  '
     if (sgname.eq.'Ibm2    ') lattyp='B  '
     if (sgname.eq.'I2cm    ') lattyp='B  '
     if (sgname.eq.'Im2a    ') lattyp='B  '
     if (sgname.eq.'Pmmm    ') lattyp='P  '
     if (sgname.eq.'Pnnn    ') lattyp='P  '
     if (sgname.eq.'Pccm    ') lattyp='P  '
     if (sgname.eq.'Pmaa    ') lattyp='P  '
     if (sgname.eq.'Pbmb    ') lattyp='P  '
     if (sgname.eq.'Pban    ') lattyp='P  '
     if (sgname.eq.'Pncb    ') lattyp='P  '
     if (sgname.eq.'Pcna    ') lattyp='P  '
     if (sgname.eq.'Pmma    ') lattyp='P  '
     if (sgname.eq.'Pbmm    ') lattyp='P  '
     if (sgname.eq.'Pmcm    ') lattyp='P  '
     if (sgname.eq.'Pmam    ') lattyp='P  '
     if (sgname.eq.'Pmmb    ') lattyp='P  '
     if (sgname.eq.'Pcmm    ') lattyp='P  '
     if (sgname.eq.'Pnna    ') lattyp='P  '
     if (sgname.eq.'Pbnn    ') lattyp='P  '
     if (sgname.eq.'Pncn    ') lattyp='P  '
     if (sgname.eq.'Pnan    ') lattyp='P  '
     if (sgname.eq.'Pnnb    ') lattyp='P  '
     if (sgname.eq.'Pcnn    ') lattyp='P  '
     if (sgname.eq.'Pmna    ') lattyp='P  '
     if (sgname.eq.'Pbmn    ') lattyp='P  '
     if (sgname.eq.'Pncm    ') lattyp='P  '
     if (sgname.eq.'Pman    ') lattyp='P  '
     if (sgname.eq.'Pnmb    ') lattyp='P  '
     if (sgname.eq.'Pcnm    ') lattyp='P  '
     if (sgname.eq.'Pcca    ') lattyp='P  '
     if (sgname.eq.'Pbaa    ') lattyp='P  '
     if (sgname.eq.'Pbcb    ') lattyp='P  '
     if (sgname.eq.'Pbab    ') lattyp='P  '
     if (sgname.eq.'Pccb    ') lattyp='P  '
     if (sgname.eq.'Pcaa    ') lattyp='P  '
     if (sgname.eq.'Pbam    ') lattyp='P  '
     if (sgname.eq.'Pmcb    ') lattyp='P  '
     if (sgname.eq.'Pcma    ') lattyp='P  '
     if (sgname.eq.'Pccn    ') lattyp='P  '
     if (sgname.eq.'Pnaa    ') lattyp='P  '
     if (sgname.eq.'Pbnb    ') lattyp='P  '
     if (sgname.eq.'Pbcm    ') lattyp='P  '
     if (sgname.eq.'Pmca    ') lattyp='P  '
     if (sgname.eq.'Pbma    ') lattyp='P  '
     if (sgname.eq.'Pcmb    ') lattyp='P  '
     if (sgname.eq.'Pcam    ') lattyp='P  '
     if (sgname.eq.'Pmab    ') lattyp='P  '
     if (sgname.eq.'Pnnm    ') lattyp='P  '
     if (sgname.eq.'Pmnn    ') lattyp='P  '
     if (sgname.eq.'Pnmn    ') lattyp='P  '
     if (sgname.eq.'Pmmn    ') lattyp='P  '
     if (sgname.eq.'Pnmm    ') lattyp='P  '
     if (sgname.eq.'Pmnm    ') lattyp='P  '
     if (sgname.eq.'Pbcn    ') lattyp='P  '
     if (sgname.eq.'Pnca    ') lattyp='P  '
     if (sgname.eq.'Pbna    ') lattyp='P  '
     if (sgname.eq.'Pcnb    ') lattyp='P  '
     if (sgname.eq.'Pcan    ') lattyp='P  '
     if (sgname.eq.'Pnab    ') lattyp='P  '
     if (sgname.eq.'Pbca    ') lattyp='P  '
     if (sgname.eq.'Pcab    ') lattyp='P  '
     if (sgname.eq.'Pnma    ') lattyp='P  '
     if (sgname.eq.'Pbnm    ') lattyp='P  '
     if (sgname.eq.'Pmcn    ') lattyp='P  '
     if (sgname.eq.'Pnam    ') lattyp='P  '
     if (sgname.eq.'Pmnb    ') lattyp='P  '
     if (sgname.eq.'Pcmn    ') lattyp='P  '
     if (sgname.eq.'Cmcm    ') lattyp='CXY'
     if (sgname.eq.'Amma    ') lattyp='CYZ'
     if (sgname.eq.'Bbmm    ') lattyp='CXZ'
     if (sgname.eq.'Bmmb    ') lattyp='CXZ'
     if (sgname.eq.'Ccmm    ') lattyp='CXY'
     if (sgname.eq.'Amam    ') lattyp='CYZ'
     if (sgname.eq.'Cmca    ') lattyp='CXY'
     if (sgname.eq.'Abma    ') lattyp='CYZ'
     if (sgname.eq.'Bbcm    ') lattyp='CXZ'
     if (sgname.eq.'Bmab    ') lattyp='CXZ'
     if (sgname.eq.'Ccmb    ') lattyp='CXY'
     if (sgname.eq.'Acam    ') lattyp='CYZ'
     if (sgname.eq.'Cmmm    ') lattyp='CXY'
     if (sgname.eq.'Ammm    ') lattyp='CYZ'
     if (sgname.eq.'Bmmm    ') lattyp='CXZ'
     if (sgname.eq.'Cccm    ') lattyp='CXY'
     if (sgname.eq.'Amaa    ') lattyp='CYZ'
     if (sgname.eq.'Bbmb    ') lattyp='CXZ'
     if (sgname.eq.'Cmma    ') lattyp='CXY'
     if (sgname.eq.'Abmm    ') lattyp='CYZ'
     if (sgname.eq.'Bmcm    ') lattyp='CXZ'
     if (sgname.eq.'Bmam    ') lattyp='CXZ'
     if (sgname.eq.'Cmmb    ') lattyp='CXY'
     if (sgname.eq.'Acmm    ') lattyp='CYZ'
     if (sgname.eq.'Ccca    ') lattyp='CXY'
     if (sgname.eq.'Abaa    ') lattyp='CYZ'
     if (sgname.eq.'Bbcb    ') lattyp='CXZ'
     if (sgname.eq.'Bbab    ') lattyp='CXZ'
     if (sgname.eq.'Cccb    ') lattyp='CXY'
     if (sgname.eq.'Acaa    ') lattyp='CYZ'
     if (sgname.eq.'Fmmm    ') lattyp='F  '
     if (sgname.eq.'Fddd    ') lattyp='F  '
     if (sgname.eq.'Immm    ') lattyp='B  '
     if (sgname.eq.'Ibam    ') lattyp='B  '
     if (sgname.eq.'Imcb    ') lattyp='B  '
     if (sgname.eq.'Icma    ') lattyp='B  '
     if (sgname.eq.'Ibca    ') lattyp='B  '
     if (sgname.eq.'Icab    ') lattyp='B  '
     if (sgname.eq.'Imma    ') lattyp='B  '
     if (sgname.eq.'Ibmm    ') lattyp='B  '
     if (sgname.eq.'Imcm    ') lattyp='B  '
     if (sgname.eq.'Imam    ') lattyp='B  '
     if (sgname.eq.'Immb    ') lattyp='B  '
     if (sgname.eq.'Icmm    ') lattyp='B  '
     if (sgname.eq.'P4      ') lattyp='P  '
     if (sgname.eq.'P41     ') lattyp='P  '
     if (sgname.eq.'P42     ') lattyp='P  '
     if (sgname.eq.'P43     ') lattyp='P  '
     if (sgname.eq.'I4      ') lattyp='B  '
     if (sgname.eq.'I41     ') lattyp='B  '
     if (sgname.eq.'P-4     ') lattyp='P  '
     if (sgname.eq.'I-4     ') lattyp='B  '
     if (sgname.eq.'P4/m    ') lattyp='P  '
     if (sgname.eq.'P42/m   ') lattyp='P  '
     if (sgname.eq.'P4/n    ') lattyp='P  '
     if (sgname.eq.'P42/n   ') lattyp='P  '
     if (sgname.eq.'I4/m    ') lattyp='B  '
     if (sgname.eq.'I41/a   ') lattyp='B  '
     if (sgname.eq.'P422    ') lattyp='P  '
     if (sgname.eq.'P4212   ') lattyp='P  '
     if (sgname.eq.'P4122   ') lattyp='P  '
     if (sgname.eq.'P41212  ') lattyp='P  '
     if (sgname.eq.'P4222   ') lattyp='P  '
     if (sgname.eq.'P42212  ') lattyp='P  '
     if (sgname.eq.'P4322   ') lattyp='P  '
     if (sgname.eq.'P43212  ') lattyp='P  '
     if (sgname.eq.'I422    ') lattyp='B  '
     if (sgname.eq.'I4122   ') lattyp='B  '
     if (sgname.eq.'P4mm    ') lattyp='P  '
     if (sgname.eq.'P4bm    ') lattyp='P  '
     if (sgname.eq.'P42cm   ') lattyp='P  '
     if (sgname.eq.'P42nm   ') lattyp='P  '
     if (sgname.eq.'P4cc    ') lattyp='P  '
     if (sgname.eq.'P4nc    ') lattyp='P  '
     if (sgname.eq.'P42mc   ') lattyp='P  '
     if (sgname.eq.'P42bc   ') lattyp='P  '
     if (sgname.eq.'I4mm    ') lattyp='B  '
     if (sgname.eq.'I4cm    ') lattyp='B  '
     if (sgname.eq.'I41md   ') lattyp='B  '
     if (sgname.eq.'I41cd   ') lattyp='B  '
     if (sgname.eq.'P-42m   ') lattyp='P  '
     if (sgname.eq.'P-42c   ') lattyp='P  '
     if (sgname.eq.'P-421m  ') lattyp='P  '
     if (sgname.eq.'P-421c  ') lattyp='P  '
     if (sgname.eq.'P-4m2   ') lattyp='P  '
     if (sgname.eq.'P-4c2   ') lattyp='P  '
     if (sgname.eq.'P-4b2   ') lattyp='P  '
     if (sgname.eq.'P-4n2   ') lattyp='P  '
     if (sgname.eq.'I-4m2   ') lattyp='B  '
     if (sgname.eq.'I-4c2   ') lattyp='B  '
     if (sgname.eq.'I-42m   ') lattyp='B  '
     if (sgname.eq.'I-42d   ') lattyp='B  '
     if (sgname.eq.'P4/mmm  ') lattyp='P  '
     if (sgname.eq.'P4/mcc  ') lattyp='P  '
     if (sgname.eq.'P4/nbm  ') lattyp='P  '
     if (sgname.eq.'P4/nnc  ') lattyp='P  '
     if (sgname.eq.'P4/mbm  ') lattyp='P  '
     if (sgname.eq.'P4/mnc  ') lattyp='P  '
     if (sgname.eq.'P4/nmm  ') lattyp='P  '
     if (sgname.eq.'P4/ncc  ') lattyp='P  '
     if (sgname.eq.'P42/mmc ') lattyp='P  '
     if (sgname.eq.'P42/mcm ') lattyp='P  '
     if (sgname.eq.'P42/nbc ') lattyp='P  '
     if (sgname.eq.'P42/nnm ') lattyp='P  '
     if (sgname.eq.'P42/mbc ') lattyp='P  '
     if (sgname.eq.'P42/mnm ') lattyp='P  '
     if (sgname.eq.'P42/nmc ') lattyp='P  '
     if (sgname.eq.'P42/ncm ') lattyp='P  '
     if (sgname.eq.'I4/mmm  ') lattyp='B  '
     if (sgname.eq.'I4/mcm  ') lattyp='B  '
     if (sgname.eq.'I41/amd ') lattyp='B  '
     if (sgname.eq.'I41/acd ') lattyp='B  '
     if (sgname.eq.'P3      ') lattyp='H  '
     if (sgname.eq.'P31     ') lattyp='H  '
     if (sgname.eq.'P32     ') lattyp='H  '
     if (sgname.eq.'R3      ') lattyp='R  '
     if (sgname.eq.'P-3     ') lattyp='H  '
     if (sgname.eq.'R-3     ') lattyp='R  '
     if (sgname.eq.'P312    ') lattyp='H  '
     if (sgname.eq.'P321    ') lattyp='H  '
     if (sgname.eq.'P3112   ') lattyp='H  '
     if (sgname.eq.'P3121   ') lattyp='H  '
     if (sgname.eq.'P3212   ') lattyp='H  '
     if (sgname.eq.'P3221   ') lattyp='H  '
     if (sgname.eq.'R32     ') lattyp='R  '
     if (sgname.eq.'P3m1    ') lattyp='H  '
     if (sgname.eq.'P31m    ') lattyp='H  '
     if (sgname.eq.'P3c1    ') lattyp='H  '
     if (sgname.eq.'P31c    ') lattyp='H  '
     if (sgname.eq.'R3m     ') lattyp='R  '
     if (sgname.eq.'R3c     ') lattyp='R  '
     if (sgname.eq.'P-31m   ') lattyp='H  '
     if (sgname.eq.'P-31c   ') lattyp='H  '
     if (sgname.eq.'P-3m1   ') lattyp='H  '
     if (sgname.eq.'P-3c1   ') lattyp='H  '
     if (sgname.eq.'R-3m    ') lattyp='R  '
     if (sgname.eq.'R-3c    ') lattyp='R  '
     if (sgname.eq.'P6      ') lattyp='H  '
     if (sgname.eq.'P61     ') lattyp='H  '
     if (sgname.eq.'P65     ') lattyp='H  '
     if (sgname.eq.'P62     ') lattyp='H  '
     if (sgname.eq.'P64     ') lattyp='H  '
     if (sgname.eq.'P63     ') lattyp='H  '
     if (sgname.eq.'P-6     ') lattyp='H  '
     if (sgname.eq.'P6/m    ') lattyp='H  '
     if (sgname.eq.'P63/m   ') lattyp='H  '
     if (sgname.eq.'P622    ') lattyp='H  '
     if (sgname.eq.'P6122   ') lattyp='H  '
     if (sgname.eq.'P6522   ') lattyp='H  '
     if (sgname.eq.'P6222   ') lattyp='H  '
     if (sgname.eq.'P6422   ') lattyp='H  '
     if (sgname.eq.'P6322   ') lattyp='H  '
     if (sgname.eq.'P6mm    ') lattyp='H  '
     if (sgname.eq.'P6cc    ') lattyp='H  '
     if (sgname.eq.'P63cm   ') lattyp='H  '
     if (sgname.eq.'P63mc   ') lattyp='H  '
     if (sgname.eq.'P-6m2   ') lattyp='H  '
     if (sgname.eq.'P-6c2   ') lattyp='H  '
     if (sgname.eq.'P-62m   ') lattyp='H  '
     if (sgname.eq.'P-62c   ') lattyp='H  '
     if (sgname.eq.'P6/mmm  ') lattyp='H  '
     if (sgname.eq.'P6/mcc  ') lattyp='H  '
     if (sgname.eq.'P63/mcm ') lattyp='H  '
     if (sgname.eq.'P63/mmc ') lattyp='H  '
     if (sgname.eq.'P23     ') lattyp='P  '
     if (sgname.eq.'F23     ') lattyp='F  '
     if (sgname.eq.'I23     ') lattyp='B  '
     if (sgname.eq.'P213    ') lattyp='P  '
     if (sgname.eq.'I213    ') lattyp='B  '
     if (sgname.eq.'Pm-3    ') lattyp='P  '
     if (sgname.eq.'Pn-3    ') lattyp='P  '
     if (sgname.eq.'Fm-3    ') lattyp='F  '
     if (sgname.eq.'Fd-3    ') lattyp='F  '
     if (sgname.eq.'Im-3    ') lattyp='B  '
     if (sgname.eq.'Pa-3    ') lattyp='P  '
     if (sgname.eq.'Ia-3    ') lattyp='B  '
     if (sgname.eq.'P432    ') lattyp='P  '
     if (sgname.eq.'P4232   ') lattyp='P  '
     if (sgname.eq.'F432    ') lattyp='F  '
     if (sgname.eq.'F4132   ') lattyp='F  '
     if (sgname.eq.'I432    ') lattyp='B  '
     if (sgname.eq.'P4332   ') lattyp='P  '
     if (sgname.eq.'P4132   ') lattyp='P  '
     if (sgname.eq.'I4132   ') lattyp='B  '
     if (sgname.eq.'P-43m   ') lattyp='P  '
     if (sgname.eq.'F-43m   ') lattyp='F  '
     if (sgname.eq.'I-43m   ') lattyp='B  '
     if (sgname.eq.'P-43n   ') lattyp='P  '
     if (sgname.eq.'F-43c   ') lattyp='F  '
     if (sgname.eq.'I-43d   ') lattyp='B  '
     if (sgname.eq.'Pm-3m   ') lattyp='P  '
     if (sgname.eq.'Pn-3n   ') lattyp='P  '
     if (sgname.eq.'Pm-3n   ') lattyp='P  '
     if (sgname.eq.'Pn-3m   ') lattyp='P  '
     if (sgname.eq.'Fm-3m   ') lattyp='F  '
     if (sgname.eq.'Fm-3c   ') lattyp='F  '
     if (sgname.eq.'Fd-3m   ') lattyp='F  '
     if (sgname.eq.'Fd-3c   ') lattyp='F  '
     if (sgname.eq.'Im-3m   ') lattyp='B  '
     if (sgname.eq.'Ia-3d   ') lattyp='B  '


   end subroutine getlattype

 subroutine getsgnum(sgname,sgnum)
! This routine translates between two different naming conventions for spacegroups.
implicit none
character*8,intent(in) :: sgname
integer,intent(out) :: sgnum

     if (sgname.eq.'P1      ')  sgnum = 1   
     if (sgname.eq.'P-1     ')  sgnum = 2   
     if (sgname.eq.'P2      ')  sgnum = 3   
     if (sgname.eq.'P2      ')  sgnum = 3   
     if (sgname.eq.'P2      ')  sgnum = 3   
     if (sgname.eq.'P21     ')  sgnum = 4   
     if (sgname.eq.'P21     ')  sgnum = 4   
     if (sgname.eq.'P21     ')  sgnum = 4   
     if (sgname.eq.'C2      ')  sgnum = 5   
     if (sgname.eq.'A2      ')  sgnum = 5   
     if (sgname.eq.'B2      ')  sgnum = 5   
     if (sgname.eq.'B2      ')  sgnum = 5   
     if (sgname.eq.'C2      ')  sgnum = 5   
     if (sgname.eq.'A2      ')  sgnum = 5   
     if (sgname.eq.'Pm      ')  sgnum = 6   
     if (sgname.eq.'Pm      ')  sgnum = 6   
     if (sgname.eq.'Pm      ')  sgnum = 6   
     if (sgname.eq.'Pc      ')  sgnum = 7   
     if (sgname.eq.'Pa      ')  sgnum = 7   
     if (sgname.eq.'Pb      ')  sgnum = 7   
     if (sgname.eq.'Pb      ')  sgnum = 7   
     if (sgname.eq.'Pc      ')  sgnum = 7   
     if (sgname.eq.'Pa      ')  sgnum = 7   
     if (sgname.eq.'Pn      ')  sgnum = 7   
     if (sgname.eq.'Pn      ')  sgnum = 7   
     if (sgname.eq.'Pn      ')  sgnum = 7   
     if (sgname.eq.'Cm      ')  sgnum = 8   
     if (sgname.eq.'Am      ')  sgnum = 8   
     if (sgname.eq.'Bm      ')  sgnum = 8   
     if (sgname.eq.'Bm      ')  sgnum = 8   
     if (sgname.eq.'Cm      ')  sgnum = 8   
     if (sgname.eq.'Am      ')  sgnum = 8   
     if (sgname.eq.'Cc      ')  sgnum = 9   
     if (sgname.eq.'Aa      ')  sgnum = 9   
     if (sgname.eq.'Bb      ')  sgnum = 9   
     if (sgname.eq.'Bb      ')  sgnum = 9   
     if (sgname.eq.'Cc      ')  sgnum = 9   
     if (sgname.eq.'Aa      ')  sgnum = 9   
     if (sgname.eq.'P2/m    ')  sgnum = 10  
     if (sgname.eq.'P2/m    ')  sgnum = 10  
     if (sgname.eq.'P2/m    ')  sgnum = 10  
     if (sgname.eq.'P21/m   ')  sgnum = 11  
     if (sgname.eq.'P21/m   ')  sgnum = 11  
     if (sgname.eq.'P21/m   ')  sgnum = 11  
     if (sgname.eq.'C2/m    ')  sgnum = 12  
     if (sgname.eq.'A2/m    ')  sgnum = 12  
     if (sgname.eq.'B2/m    ')  sgnum = 12  
     if (sgname.eq.'B2/m    ')  sgnum = 12  
     if (sgname.eq.'C2/m    ')  sgnum = 12  
     if (sgname.eq.'A2/m    ')  sgnum = 12  
     if (sgname.eq.'P2/c    ')  sgnum = 13  
     if (sgname.eq.'P2/a    ')  sgnum = 13  
     if (sgname.eq.'P2/b    ')  sgnum = 13  
     if (sgname.eq.'P2/b    ')  sgnum = 13  
     if (sgname.eq.'P2/c    ')  sgnum = 13  
     if (sgname.eq.'P2/a    ')  sgnum = 13  
     if (sgname.eq.'P2/n    ')  sgnum = 13  
     if (sgname.eq.'P2/n    ')  sgnum = 13  
     if (sgname.eq.'P2/n    ')  sgnum = 13  
     if (sgname.eq.'P21/c   ')  sgnum = 14  
     if (sgname.eq.'P21/a   ')  sgnum = 14  
     if (sgname.eq.'P21/b   ')  sgnum = 14  
     if (sgname.eq.'P21/b   ')  sgnum = 14  
     if (sgname.eq.'P21/c   ')  sgnum = 14  
     if (sgname.eq.'P21/a   ')  sgnum = 14  
     if (sgname.eq.'P21/n   ')  sgnum = 14  
     if (sgname.eq.'P21/n   ')  sgnum = 14  
     if (sgname.eq.'P21/n   ')  sgnum = 14  
     if (sgname.eq.'C2/c    ')  sgnum = 15  
     if (sgname.eq.'A2/a    ')  sgnum = 15  
     if (sgname.eq.'B2/b    ')  sgnum = 15  
     if (sgname.eq.'B2/b    ')  sgnum = 15  
     if (sgname.eq.'C2/c    ')  sgnum = 15  
     if (sgname.eq.'A2/a    ')  sgnum = 15  
     if (sgname.eq.'P222    ')  sgnum = 16  
     if (sgname.eq.'P2221   ')  sgnum = 17  
     if (sgname.eq.'P2122   ')  sgnum = 17  
     if (sgname.eq.'P2212   ')  sgnum = 17  
     if (sgname.eq.'P21212  ')  sgnum = 18  
     if (sgname.eq.'P22121  ')  sgnum = 18  
     if (sgname.eq.'P21221  ')  sgnum = 18  
     if (sgname.eq.'P212121 ')  sgnum = 19  
     if (sgname.eq.'C2221   ')  sgnum = 20  
     if (sgname.eq.'A2122   ')  sgnum = 20  
     if (sgname.eq.'B2212   ')  sgnum = 20  
     if (sgname.eq.'C222    ')  sgnum = 21  
     if (sgname.eq.'A222    ')  sgnum = 21  
     if (sgname.eq.'B222    ')  sgnum = 21  
     if (sgname.eq.'F222    ')  sgnum = 22  
     if (sgname.eq.'I222    ')  sgnum = 23  
     if (sgname.eq.'I212121 ')  sgnum = 24  
     if (sgname.eq.'Pmm2    ')  sgnum = 25  
     if (sgname.eq.'P2mm    ')  sgnum = 25  
     if (sgname.eq.'Pm2m    ')  sgnum = 25  
     if (sgname.eq.'Pmc21   ')  sgnum = 26  
     if (sgname.eq.'P21ma   ')  sgnum = 26  
     if (sgname.eq.'Pb21m   ')  sgnum = 26  
     if (sgname.eq.'Pcm21   ')  sgnum = 26  
     if (sgname.eq.'P21am   ')  sgnum = 26  
     if (sgname.eq.'Pm21b   ')  sgnum = 26  
     if (sgname.eq.'Pcc2    ')  sgnum = 27  
     if (sgname.eq.'P2aa    ')  sgnum = 27  
     if (sgname.eq.'Pb2b    ')  sgnum = 27  
     if (sgname.eq.'Pma2    ')  sgnum = 28  
     if (sgname.eq.'P2mb    ')  sgnum = 28  
     if (sgname.eq.'Pc2m    ')  sgnum = 28  
     if (sgname.eq.'Pbm2    ')  sgnum = 28  
     if (sgname.eq.'P2cm    ')  sgnum = 28  
     if (sgname.eq.'Pm2a    ')  sgnum = 28  
     if (sgname.eq.'Pca21   ')  sgnum = 29  
     if (sgname.eq.'P21ab   ')  sgnum = 29  
     if (sgname.eq.'Pc21b   ')  sgnum = 29  
     if (sgname.eq.'Pbc21   ')  sgnum = 29  
     if (sgname.eq.'P21ca   ')  sgnum = 29  
     if (sgname.eq.'Pb21a   ')  sgnum = 29  
     if (sgname.eq.'Pnc2    ')  sgnum = 30  
     if (sgname.eq.'P2na    ')  sgnum = 30  
     if (sgname.eq.'Pb2n    ')  sgnum = 30  
     if (sgname.eq.'Pcn2    ')  sgnum = 30  
     if (sgname.eq.'P2an    ')  sgnum = 30  
     if (sgname.eq.'Pn2b    ')  sgnum = 30  
     if (sgname.eq.'Pmn21   ')  sgnum = 31  
     if (sgname.eq.'P21mn   ')  sgnum = 31  
     if (sgname.eq.'Pn21m   ')  sgnum = 31  
     if (sgname.eq.'Pnm21   ')  sgnum = 31  
     if (sgname.eq.'P21nm   ')  sgnum = 31  
     if (sgname.eq.'Pm21n   ')  sgnum = 31  
     if (sgname.eq.'Pba2    ')  sgnum = 32  
     if (sgname.eq.'P2cb    ')  sgnum = 32  
     if (sgname.eq.'Pc2a    ')  sgnum = 32  
     if (sgname.eq.'Pna21   ')  sgnum = 33  
     if (sgname.eq.'P21nb   ')  sgnum = 33  
     if (sgname.eq.'Pc21n   ')  sgnum = 33  
     if (sgname.eq.'Pbn21   ')  sgnum = 33  
     if (sgname.eq.'P21cn   ')  sgnum = 33  
     if (sgname.eq.'Pn21a   ')  sgnum = 33  
     if (sgname.eq.'Pnn2    ')  sgnum = 34  
     if (sgname.eq.'P2nn    ')  sgnum = 34  
     if (sgname.eq.'Pn2n    ')  sgnum = 34  
     if (sgname.eq.'Cmm2    ')  sgnum = 35  
     if (sgname.eq.'A2mm    ')  sgnum = 35  
     if (sgname.eq.'Bm2m    ')  sgnum = 35  
     if (sgname.eq.'Cmc21   ')  sgnum = 36  
     if (sgname.eq.'A21ma   ')  sgnum = 36  
     if (sgname.eq.'Bb21m   ')  sgnum = 36  
     if (sgname.eq.'Ccm21   ')  sgnum = 36  
     if (sgname.eq.'A21am   ')  sgnum = 36  
     if (sgname.eq.'Bm21b   ')  sgnum = 36  
     if (sgname.eq.'Ccc2    ')  sgnum = 37  
     if (sgname.eq.'A2aa    ')  sgnum = 37  
     if (sgname.eq.'Bb2b    ')  sgnum = 37  
     if (sgname.eq.'Amm2    ')  sgnum = 38  
     if (sgname.eq.'B2mm    ')  sgnum = 38  
     if (sgname.eq.'Cm2m    ')  sgnum = 38  
     if (sgname.eq.'Abm2    ')  sgnum = 39  
     if (sgname.eq.'B2cm    ')  sgnum = 39  
     if (sgname.eq.'Cm2a    ')  sgnum = 39  
     if (sgname.eq.'Bma2    ')  sgnum = 39  
     if (sgname.eq.'C2mb    ')  sgnum = 39  
     if (sgname.eq.'Ac2m    ')  sgnum = 39  
     if (sgname.eq.'Ama2    ')  sgnum = 40  
     if (sgname.eq.'B2mb    ')  sgnum = 40  
     if (sgname.eq.'Cc2m    ')  sgnum = 40  
     if (sgname.eq.'Bbm2    ')  sgnum = 40  
     if (sgname.eq.'C2cm    ')  sgnum = 40  
     if (sgname.eq.'Am2a    ')  sgnum = 40  
     if (sgname.eq.'Aba2    ')  sgnum = 41  
     if (sgname.eq.'B2cb    ')  sgnum = 41  
     if (sgname.eq.'Cc2a    ')  sgnum = 41  
     if (sgname.eq.'Bba2    ')  sgnum = 41  
     if (sgname.eq.'C2cb    ')  sgnum = 41  
     if (sgname.eq.'Ac2a    ')  sgnum = 41  
     if (sgname.eq.'Fmm2    ')  sgnum = 42  
     if (sgname.eq.'F2mm    ')  sgnum = 42  
     if (sgname.eq.'Fm2m    ')  sgnum = 42  
     if (sgname.eq.'Fdd2    ')  sgnum = 43  
     if (sgname.eq.'F2dd    ')  sgnum = 43  
     if (sgname.eq.'Fd2d    ')  sgnum = 43  
     if (sgname.eq.'Imm2    ')  sgnum = 44  
     if (sgname.eq.'I2mm    ')  sgnum = 44  
     if (sgname.eq.'Im2m    ')  sgnum = 44  
     if (sgname.eq.'Iba2    ')  sgnum = 45  
     if (sgname.eq.'I2cb    ')  sgnum = 45  
     if (sgname.eq.'Ic2a    ')  sgnum = 45  
     if (sgname.eq.'Ima2    ')  sgnum = 46  
     if (sgname.eq.'I2mb    ')  sgnum = 46  
     if (sgname.eq.'Ic2m    ')  sgnum = 46  
     if (sgname.eq.'Ibm2    ')  sgnum = 46  
     if (sgname.eq.'I2cm    ')  sgnum = 46  
     if (sgname.eq.'Im2a    ')  sgnum = 46  
     if (sgname.eq.'Pmmm    ')  sgnum = 47  
     if (sgname.eq.'Pnnn    ')  sgnum = 48  
     if (sgname.eq.'Pccm    ')  sgnum = 49  
     if (sgname.eq.'Pmaa    ')  sgnum = 49  
     if (sgname.eq.'Pbmb    ')  sgnum = 49  
     if (sgname.eq.'Pban    ')  sgnum = 50  
     if (sgname.eq.'Pncb    ')  sgnum = 50  
     if (sgname.eq.'Pcna    ')  sgnum = 50  
     if (sgname.eq.'Pmma    ')  sgnum = 51  
     if (sgname.eq.'Pbmm    ')  sgnum = 51  
     if (sgname.eq.'Pmcm    ')  sgnum = 51  
     if (sgname.eq.'Pmam    ')  sgnum = 51  
     if (sgname.eq.'Pmmb    ')  sgnum = 51  
     if (sgname.eq.'Pcmm    ')  sgnum = 51  
     if (sgname.eq.'Pnna    ')  sgnum = 52  
     if (sgname.eq.'Pbnn    ')  sgnum = 52  
     if (sgname.eq.'Pncn    ')  sgnum = 52  
     if (sgname.eq.'Pnan    ')  sgnum = 52  
     if (sgname.eq.'Pnnb    ')  sgnum = 52  
     if (sgname.eq.'Pcnn    ')  sgnum = 52  
     if (sgname.eq.'Pmna    ')  sgnum = 53  
     if (sgname.eq.'Pbmn    ')  sgnum = 53  
     if (sgname.eq.'Pncm    ')  sgnum = 53  
     if (sgname.eq.'Pman    ')  sgnum = 53  
     if (sgname.eq.'Pnmb    ')  sgnum = 53  
     if (sgname.eq.'Pcnm    ')  sgnum = 53  
     if (sgname.eq.'Pcca    ')  sgnum = 54  
     if (sgname.eq.'Pbaa    ')  sgnum = 54  
     if (sgname.eq.'Pbcb    ')  sgnum = 54  
     if (sgname.eq.'Pbab    ')  sgnum = 54  
     if (sgname.eq.'Pccb    ')  sgnum = 54  
     if (sgname.eq.'Pcaa    ')  sgnum = 54  
     if (sgname.eq.'Pbam    ')  sgnum = 55  
     if (sgname.eq.'Pmcb    ')  sgnum = 55  
     if (sgname.eq.'Pcma    ')  sgnum = 55  
     if (sgname.eq.'Pccn    ')  sgnum = 56  
     if (sgname.eq.'Pnaa    ')  sgnum = 56  
     if (sgname.eq.'Pbnb    ')  sgnum = 56  
     if (sgname.eq.'Pbcm    ')  sgnum = 57  
     if (sgname.eq.'Pmca    ')  sgnum = 57  
     if (sgname.eq.'Pbma    ')  sgnum = 57  
     if (sgname.eq.'Pcmb    ')  sgnum = 57  
     if (sgname.eq.'Pcam    ')  sgnum = 57  
     if (sgname.eq.'Pmab    ')  sgnum = 57  
     if (sgname.eq.'Pnnm    ')  sgnum = 58  
     if (sgname.eq.'Pmnn    ')  sgnum = 58  
     if (sgname.eq.'Pnmn    ')  sgnum = 58  
     if (sgname.eq.'Pmmn    ')  sgnum = 59  
     if (sgname.eq.'Pnmm    ')  sgnum = 59  
     if (sgname.eq.'Pmnm    ')  sgnum = 59  
     if (sgname.eq.'Pbcn    ')  sgnum = 60  
     if (sgname.eq.'Pnca    ')  sgnum = 60  
     if (sgname.eq.'Pbna    ')  sgnum = 60  
     if (sgname.eq.'Pcnb    ')  sgnum = 60  
     if (sgname.eq.'Pcan    ')  sgnum = 60  
     if (sgname.eq.'Pnab    ')  sgnum = 60  
     if (sgname.eq.'Pbca    ')  sgnum = 61  
     if (sgname.eq.'Pcab    ')  sgnum = 61  
     if (sgname.eq.'Pnma    ')  sgnum = 62  
     if (sgname.eq.'Pbnm    ')  sgnum = 62  
     if (sgname.eq.'Pmcn    ')  sgnum = 62  
     if (sgname.eq.'Pnam    ')  sgnum = 62  
     if (sgname.eq.'Pmnb    ')  sgnum = 62  
     if (sgname.eq.'Pcmn    ')  sgnum = 62  
     if (sgname.eq.'Cmcm    ')  sgnum = 63  
     if (sgname.eq.'Amma    ')  sgnum = 63  
     if (sgname.eq.'Bbmm    ')  sgnum = 63  
     if (sgname.eq.'Bmmb    ')  sgnum = 63  
     if (sgname.eq.'Ccmm    ')  sgnum = 63  
     if (sgname.eq.'Amam    ')  sgnum = 63  
     if (sgname.eq.'Cmca    ')  sgnum = 64  
     if (sgname.eq.'Abma    ')  sgnum = 64  
     if (sgname.eq.'Bbcm    ')  sgnum = 64  
     if (sgname.eq.'Bmab    ')  sgnum = 64  
     if (sgname.eq.'Ccmb    ')  sgnum = 64  
     if (sgname.eq.'Acam    ')  sgnum = 64  
     if (sgname.eq.'Cmmm    ')  sgnum = 65  
     if (sgname.eq.'Ammm    ')  sgnum = 65  
     if (sgname.eq.'Bmmm    ')  sgnum = 65  
     if (sgname.eq.'Cccm    ')  sgnum = 66  
     if (sgname.eq.'Amaa    ')  sgnum = 66  
     if (sgname.eq.'Bbmb    ')  sgnum = 66  
     if (sgname.eq.'Cmma    ')  sgnum = 67  
     if (sgname.eq.'Abmm    ')  sgnum = 67  
     if (sgname.eq.'Bmcm    ')  sgnum = 67  
     if (sgname.eq.'Bmam    ')  sgnum = 67  
     if (sgname.eq.'Cmmb    ')  sgnum = 67  
     if (sgname.eq.'Acmm    ')  sgnum = 67  
     if (sgname.eq.'Ccca    ')  sgnum = 68  
     if (sgname.eq.'Abaa    ')  sgnum = 68  
     if (sgname.eq.'Bbcb    ')  sgnum = 68  
     if (sgname.eq.'Bbab    ')  sgnum = 68  
     if (sgname.eq.'Cccb    ')  sgnum = 68  
     if (sgname.eq.'Acaa    ')  sgnum = 68  
     if (sgname.eq.'Fmmm    ')  sgnum = 69  
     if (sgname.eq.'Fddd    ')  sgnum = 70  
     if (sgname.eq.'Immm    ')  sgnum = 71  
     if (sgname.eq.'Ibam    ')  sgnum = 72  
     if (sgname.eq.'Imcb    ')  sgnum = 72  
     if (sgname.eq.'Icma    ')  sgnum = 72  
     if (sgname.eq.'Ibca    ')  sgnum = 73  
     if (sgname.eq.'Icab    ')  sgnum = 73  
     if (sgname.eq.'Imma    ')  sgnum = 74  
     if (sgname.eq.'Ibmm    ')  sgnum = 74  
     if (sgname.eq.'Imcm    ')  sgnum = 74  
     if (sgname.eq.'Imam    ')  sgnum = 74  
     if (sgname.eq.'Immb    ')  sgnum = 74  
     if (sgname.eq.'Icmm    ')  sgnum = 74  
     if (sgname.eq.'P4      ')  sgnum = 75  
     if (sgname.eq.'P41     ')  sgnum = 76  
     if (sgname.eq.'P42     ')  sgnum = 77  
     if (sgname.eq.'P43     ')  sgnum = 78  
     if (sgname.eq.'I4      ')  sgnum = 79  
     if (sgname.eq.'I41     ')  sgnum = 80  
     if (sgname.eq.'P-4     ')  sgnum = 81  
     if (sgname.eq.'I-4     ')  sgnum = 82  
     if (sgname.eq.'P4/m    ')  sgnum = 83  
     if (sgname.eq.'P42/m   ')  sgnum = 84  
     if (sgname.eq.'P4/n    ')  sgnum = 85  
     if (sgname.eq.'P42/n   ')  sgnum = 86  
     if (sgname.eq.'I4/m    ')  sgnum = 87  
     if (sgname.eq.'I41/a   ')  sgnum = 88  
     if (sgname.eq.'P422    ')  sgnum = 89  
     if (sgname.eq.'P4212   ')  sgnum = 90  
     if (sgname.eq.'P4122   ')  sgnum = 91  
     if (sgname.eq.'P41212  ')  sgnum = 92  
     if (sgname.eq.'P4222   ')  sgnum = 93  
     if (sgname.eq.'P42212  ')  sgnum = 94  
     if (sgname.eq.'P4322   ')  sgnum = 95  
     if (sgname.eq.'P43212  ')  sgnum = 96  
     if (sgname.eq.'I422    ')  sgnum = 97  
     if (sgname.eq.'I4122   ')  sgnum = 98  
     if (sgname.eq.'P4mm    ')  sgnum = 99  
     if (sgname.eq.'P4bm    ')  sgnum = 100 
     if (sgname.eq.'P42cm   ')  sgnum = 101 
     if (sgname.eq.'P42nm   ')  sgnum = 102 
     if (sgname.eq.'P4cc    ')  sgnum = 103 
     if (sgname.eq.'P4nc    ')  sgnum = 104 
     if (sgname.eq.'P42mc   ')  sgnum = 105 
     if (sgname.eq.'P42bc   ')  sgnum = 106 
     if (sgname.eq.'I4mm    ')  sgnum = 107 
     if (sgname.eq.'I4cm    ')  sgnum = 108 
     if (sgname.eq.'I41md   ')  sgnum = 109 
     if (sgname.eq.'I41cd   ')  sgnum = 110 
     if (sgname.eq.'P-42m   ')  sgnum = 111 
     if (sgname.eq.'P-42c   ')  sgnum = 112 
     if (sgname.eq.'P-421m  ')  sgnum = 113 
     if (sgname.eq.'P-421c  ')  sgnum = 114 
     if (sgname.eq.'P-4m2   ')  sgnum = 115 
     if (sgname.eq.'P-4c2   ')  sgnum = 116 
     if (sgname.eq.'P-4b2   ')  sgnum = 117 
     if (sgname.eq.'P-4n2   ')  sgnum = 118 
     if (sgname.eq.'I-4m2   ')  sgnum = 119 
     if (sgname.eq.'I-4c2   ')  sgnum = 120 
     if (sgname.eq.'I-42m   ')  sgnum = 121 
     if (sgname.eq.'I-42d   ')  sgnum = 122 
     if (sgname.eq.'P4/mmm  ')  sgnum = 123 
     if (sgname.eq.'P4/mcc  ')  sgnum = 124 
     if (sgname.eq.'P4/nbm  ')  sgnum = 125 
     if (sgname.eq.'P4/nnc  ')  sgnum = 126 
     if (sgname.eq.'P4/mbm  ')  sgnum = 127 
     if (sgname.eq.'P4/mnc  ')  sgnum = 128 
     if (sgname.eq.'P4/nmm  ')  sgnum = 129 
     if (sgname.eq.'P4/ncc  ')  sgnum = 130 
     if (sgname.eq.'P42/mmc ')  sgnum = 131 
     if (sgname.eq.'P42/mcm ')  sgnum = 132 
     if (sgname.eq.'P42/nbc ')  sgnum = 133 
     if (sgname.eq.'P42/nnm ')  sgnum = 134 
     if (sgname.eq.'P42/mbc ')  sgnum = 135 
     if (sgname.eq.'P42/mnm ')  sgnum = 136 
     if (sgname.eq.'P42/nmc ')  sgnum = 137 
     if (sgname.eq.'P42/ncm ')  sgnum = 138 
     if (sgname.eq.'I4/mmm  ')  sgnum = 139 
     if (sgname.eq.'I4/mcm  ')  sgnum = 140 
     if (sgname.eq.'I41/amd ')  sgnum = 141 
     if (sgname.eq.'I41/acd ')  sgnum = 142 
     if (sgname.eq.'P3      ')  sgnum = 143 
     if (sgname.eq.'P31     ')  sgnum = 144 
     if (sgname.eq.'P32     ')  sgnum = 145 
     if (sgname.eq.'R3      ')  sgnum = 146 
     if (sgname.eq.'P-3     ')  sgnum = 147 
     if (sgname.eq.'R-3     ')  sgnum = 148 
     if (sgname.eq.'P312    ')  sgnum = 149 
     if (sgname.eq.'P321    ')  sgnum = 150 
     if (sgname.eq.'P3112   ')  sgnum = 151 
     if (sgname.eq.'P3121   ')  sgnum = 152 
     if (sgname.eq.'P3212   ')  sgnum = 153 
     if (sgname.eq.'P3221   ')  sgnum = 154 
     if (sgname.eq.'R32     ')  sgnum = 155 
     if (sgname.eq.'P3m1    ')  sgnum = 156 
     if (sgname.eq.'P31m    ')  sgnum = 157 
     if (sgname.eq.'P3c1    ')  sgnum = 158 
     if (sgname.eq.'P31c    ')  sgnum = 159 
     if (sgname.eq.'R3m     ')  sgnum = 160 
     if (sgname.eq.'R3c     ')  sgnum = 161 
     if (sgname.eq.'P-31m   ')  sgnum = 162 
     if (sgname.eq.'P-31c   ')  sgnum = 163 
     if (sgname.eq.'P-3m1   ')  sgnum = 164 
     if (sgname.eq.'P-3c1   ')  sgnum = 165 
     if (sgname.eq.'R-3m    ')  sgnum = 166 
     if (sgname.eq.'R-3c    ')  sgnum = 167 
     if (sgname.eq.'P6      ')  sgnum = 168 
     if (sgname.eq.'P61     ')  sgnum = 169 
     if (sgname.eq.'P65     ')  sgnum = 170 
     if (sgname.eq.'P62     ')  sgnum = 171 
     if (sgname.eq.'P64     ')  sgnum = 172 
     if (sgname.eq.'P63     ')  sgnum = 173 
     if (sgname.eq.'P-6     ')  sgnum = 174 
     if (sgname.eq.'P6/m    ')  sgnum = 175 
     if (sgname.eq.'P63/m   ')  sgnum = 176 
     if (sgname.eq.'P622    ')  sgnum = 177 
     if (sgname.eq.'P6122   ')  sgnum = 178 
     if (sgname.eq.'P6522   ')  sgnum = 179 
     if (sgname.eq.'P6222   ')  sgnum = 180 
     if (sgname.eq.'P6422   ')  sgnum = 181 
     if (sgname.eq.'P6322   ')  sgnum = 182 
     if (sgname.eq.'P6mm    ')  sgnum = 183 
     if (sgname.eq.'P6cc    ')  sgnum = 184 
     if (sgname.eq.'P63cm   ')  sgnum = 185 
     if (sgname.eq.'P63mc   ')  sgnum = 186 
     if (sgname.eq.'P-6m2   ')  sgnum = 187 
     if (sgname.eq.'P-6c2   ')  sgnum = 188 
     if (sgname.eq.'P-62m   ')  sgnum = 189 
     if (sgname.eq.'P-62c   ')  sgnum = 190 
     if (sgname.eq.'P6/mmm  ')  sgnum = 191 
     if (sgname.eq.'P6/mcc  ')  sgnum = 192 
     if (sgname.eq.'P63/mcm ')  sgnum = 193 
     if (sgname.eq.'P63/mmc ')  sgnum = 194 
     if (sgname.eq.'P23     ')  sgnum = 195 
     if (sgname.eq.'F23     ')  sgnum = 196 
     if (sgname.eq.'I23     ')  sgnum = 197 
     if (sgname.eq.'P213    ')  sgnum = 198 
     if (sgname.eq.'I213    ')  sgnum = 199 
     if (sgname.eq.'Pm-3    ')  sgnum = 200 
     if (sgname.eq.'Pn-3    ')  sgnum = 201 
     if (sgname.eq.'Fm-3    ')  sgnum = 202 
     if (sgname.eq.'Fd-3    ')  sgnum = 203 
     if (sgname.eq.'Im-3    ')  sgnum = 204 
     if (sgname.eq.'Pa-3    ')  sgnum = 205 
     if (sgname.eq.'Ia-3    ')  sgnum = 206 
     if (sgname.eq.'P432    ')  sgnum = 207 
     if (sgname.eq.'P4232   ')  sgnum = 208 
     if (sgname.eq.'F432    ')  sgnum = 209 
     if (sgname.eq.'F4132   ')  sgnum = 210 
     if (sgname.eq.'I432    ')  sgnum = 211 
     if (sgname.eq.'P4332   ')  sgnum = 212 
     if (sgname.eq.'P4132   ')  sgnum = 213 
     if (sgname.eq.'I4132   ')  sgnum = 214 
     if (sgname.eq.'P-43m   ')  sgnum = 215 
     if (sgname.eq.'F-43m   ')  sgnum = 216 
     if (sgname.eq.'I-43m   ')  sgnum = 217 
     if (sgname.eq.'P-43n   ')  sgnum = 218 
     if (sgname.eq.'F-43c   ')  sgnum = 219 
     if (sgname.eq.'I-43d   ')  sgnum = 220 
     if (sgname.eq.'Pm-3m   ')  sgnum = 221 
     if (sgname.eq.'Pn-3n   ')  sgnum = 222 
     if (sgname.eq.'Pm-3n   ')  sgnum = 223 
     if (sgname.eq.'Pn-3m   ')  sgnum = 224 
     if (sgname.eq.'Fm-3m   ')  sgnum = 225 
     if (sgname.eq.'Fm-3c   ')  sgnum = 226 
     if (sgname.eq.'Fd-3m   ')  sgnum = 227 
     if (sgname.eq.'Fd-3c   ')  sgnum = 228 
     if (sgname.eq.'Im-3m   ')  sgnum = 229 
     if (sgname.eq.'Ia-3d   ')  sgnum = 230 

   end subroutine getsgnum


 subroutine getsgrhm(sgnum,sgname)

   integer sgnum
   character*8 sgname

   sgname='        '
   if (sgnum.eq.  1) sgname='P1      '
   if (sgnum.eq.  2) sgname='P-1     '
   if (sgnum.eq.  3) sgname='P2      '
   if (sgnum.eq.  4) sgname='P21     '
   if (sgnum.eq.  5) sgname='C2      '
   if (sgnum.eq.  5) sgname='A2      '
   if (sgnum.eq.  5) sgname='B2      '
   if (sgnum.eq.  5) sgname='B2      '
   if (sgnum.eq.  5) sgname='C2      '
   if (sgnum.eq.  5) sgname='A2      '
   if (sgnum.eq.  6) sgname='Pm      '
   if (sgnum.eq.  6) sgname='Pm      '
   if (sgnum.eq.  6) sgname='Pm      '
   if (sgnum.eq.  7) sgname='Pc      '
   if (sgnum.eq.  7) sgname='Pa      '
   if (sgnum.eq.  7) sgname='Pb      '
   if (sgnum.eq.  7) sgname='Pb      '
   if (sgnum.eq.  7) sgname='Pc      '
   if (sgnum.eq.  7) sgname='Pa      '
   if (sgnum.eq.  7) sgname='Pn      '
   if (sgnum.eq.  7) sgname='Pn      '
   if (sgnum.eq.  7) sgname='Pn      '
   if (sgnum.eq.  8) sgname='Cm      '
   if (sgnum.eq.  8) sgname='Am      '
   if (sgnum.eq.  8) sgname='Bm      '
   if (sgnum.eq.  8) sgname='Bm      '
   if (sgnum.eq.  8) sgname='Cm      '
   if (sgnum.eq.  8) sgname='Am      '
   if (sgnum.eq.  9) sgname='Cc      '
   if (sgnum.eq.  9) sgname='Aa      '
   if (sgnum.eq.  9) sgname='Bb      '
   if (sgnum.eq.  9) sgname='Bb      '
   if (sgnum.eq.  9) sgname='Cc      '
   if (sgnum.eq.  9) sgname='Aa      '
   if (sgnum.eq. 10) sgname='P2/m    '
   if (sgnum.eq. 10) sgname='P2/m    '
   if (sgnum.eq. 10) sgname='P2/m    '
   if (sgnum.eq. 11) sgname='P21/m   '
   if (sgnum.eq. 11) sgname='P21/m   '
   if (sgnum.eq. 11) sgname='P21/m   '
   if (sgnum.eq. 12) sgname='C2/m    '
   if (sgnum.eq. 12) sgname='A2/m    '
   if (sgnum.eq. 12) sgname='B2/m    '
   if (sgnum.eq. 12) sgname='B2/m    '
   if (sgnum.eq. 12) sgname='C2/m    '
   if (sgnum.eq. 12) sgname='A2/m    '
   if (sgnum.eq. 13) sgname='P2/c    '
   if (sgnum.eq. 13) sgname='P2/a    '
   if (sgnum.eq. 13) sgname='P2/b    '
   if (sgnum.eq. 13) sgname='P2/b    '
   if (sgnum.eq. 13) sgname='P2/c    '
   if (sgnum.eq. 13) sgname='P2/a    '
   if (sgnum.eq. 13) sgname='P2/n    '
   if (sgnum.eq. 13) sgname='P2/n    '
   if (sgnum.eq. 13) sgname='P2/n    '
   if (sgnum.eq. 14) sgname='P21/c   '
   if (sgnum.eq. 14) sgname='P21/a   '
   if (sgnum.eq. 14) sgname='P21/b   '
   if (sgnum.eq. 14) sgname='P21/b   '
   if (sgnum.eq. 14) sgname='P21/c   '
   if (sgnum.eq. 14) sgname='P21/a   '
   if (sgnum.eq. 14) sgname='P21/n   '
   if (sgnum.eq. 14) sgname='P21/n   '
   if (sgnum.eq. 14) sgname='P21/n   '
   if (sgnum.eq. 15) sgname='C2/c    '
   if (sgnum.eq. 15) sgname='A2/a    '
   if (sgnum.eq. 15) sgname='B2/b    '
   if (sgnum.eq. 15) sgname='B2/b    '
   if (sgnum.eq. 15) sgname='C2/c    '
   if (sgnum.eq. 15) sgname='A2/a    '
   if (sgnum.eq. 16) sgname='P222    '
   if (sgnum.eq. 17) sgname='P2221   '
   if (sgnum.eq. 17) sgname='P2122   '
   if (sgnum.eq. 17) sgname='P2212   '
   if (sgnum.eq. 18) sgname='P21212  '
   if (sgnum.eq. 18) sgname='P22121  '
   if (sgnum.eq. 18) sgname='P21221  '
   if (sgnum.eq. 19) sgname='P212121 '
   if (sgnum.eq. 20) sgname='C2221   '
   if (sgnum.eq. 20) sgname='A2122   '
   if (sgnum.eq. 20) sgname='B2212   '
   if (sgnum.eq. 21) sgname='C222    '
   if (sgnum.eq. 21) sgname='A222    '
   if (sgnum.eq. 21) sgname='B222    '
   if (sgnum.eq. 22) sgname='F222    '
   if (sgnum.eq. 23) sgname='I222    '
   if (sgnum.eq. 24) sgname='I212121 '
   if (sgnum.eq. 25) sgname='Pmm2    '
   if (sgnum.eq. 25) sgname='P2mm    '
   if (sgnum.eq. 25) sgname='Pm2m    '
   if (sgnum.eq. 26) sgname='Pmc21   '
   if (sgnum.eq. 26) sgname='P21ma   '
   if (sgnum.eq. 26) sgname='Pb21m   '
   if (sgnum.eq. 26) sgname='Pcm21   '
   if (sgnum.eq. 26) sgname='P21am   '
   if (sgnum.eq. 26) sgname='Pm21b   '
   if (sgnum.eq. 27) sgname='Pcc2    '
   if (sgnum.eq. 27) sgname='P2aa    '
   if (sgnum.eq. 27) sgname='Pb2b    '
   if (sgnum.eq. 28) sgname='Pma2    '
   if (sgnum.eq. 28) sgname='P2mb    '
   if (sgnum.eq. 28) sgname='Pc2m    '
   if (sgnum.eq. 28) sgname='Pbm2    '
   if (sgnum.eq. 28) sgname='P2cm    '
   if (sgnum.eq. 28) sgname='Pm2a    '
   if (sgnum.eq. 29) sgname='Pca21   '
   if (sgnum.eq. 29) sgname='P21ab   '
   if (sgnum.eq. 29) sgname='Pc21b   '
   if (sgnum.eq. 29) sgname='Pbc21   '
   if (sgnum.eq. 29) sgname='P21ca   '
   if (sgnum.eq. 29) sgname='Pb21a   '
   if (sgnum.eq. 30) sgname='Pnc2    '
   if (sgnum.eq. 30) sgname='P2na    '
   if (sgnum.eq. 30) sgname='Pb2n    '
   if (sgnum.eq. 30) sgname='Pcn2    '
   if (sgnum.eq. 30) sgname='P2an    '
   if (sgnum.eq. 30) sgname='Pn2b    '
   if (sgnum.eq. 31) sgname='Pmn21   '
   if (sgnum.eq. 31) sgname='P21mn   '
   if (sgnum.eq. 31) sgname='Pn21m   '
   if (sgnum.eq. 31) sgname='Pnm21   '
   if (sgnum.eq. 31) sgname='P21nm   '
   if (sgnum.eq. 31) sgname='Pm21n   '
   if (sgnum.eq. 32) sgname='Pba2    '
   if (sgnum.eq. 32) sgname='P2cb    '
   if (sgnum.eq. 32) sgname='Pc2a    '
   if (sgnum.eq. 33) sgname='Pna21   '
   if (sgnum.eq. 33) sgname='P21nb   '
   if (sgnum.eq. 33) sgname='Pc21n   '
   if (sgnum.eq. 33) sgname='Pbn21   '
   if (sgnum.eq. 33) sgname='P21cn   '
   if (sgnum.eq. 33) sgname='Pn21a   '
   if (sgnum.eq. 34) sgname='Pnn2    '
   if (sgnum.eq. 34) sgname='P2nn    '
   if (sgnum.eq. 34) sgname='Pn2n    '
   if (sgnum.eq. 35) sgname='Cmm2    '
   if (sgnum.eq. 35) sgname='A2mm    '
   if (sgnum.eq. 35) sgname='Bm2m    '
   if (sgnum.eq. 36) sgname='Cmc21   '
   if (sgnum.eq. 36) sgname='A21ma   '
   if (sgnum.eq. 36) sgname='Bb21m   '
   if (sgnum.eq. 36) sgname='Ccm21   '
   if (sgnum.eq. 36) sgname='A21am   '
   if (sgnum.eq. 36) sgname='Bm21b   '
   if (sgnum.eq. 37) sgname='Ccc2    '
   if (sgnum.eq. 37) sgname='A2aa    '
   if (sgnum.eq. 37) sgname='Bb2b    '
   if (sgnum.eq. 38) sgname='Amm2    '
   if (sgnum.eq. 38) sgname='B2mm    '
   if (sgnum.eq. 38) sgname='Cm2m    '
   if (sgnum.eq. 39) sgname='Abm2    '
   if (sgnum.eq. 39) sgname='B2cm    '
   if (sgnum.eq. 39) sgname='Cm2a    '
   if (sgnum.eq. 39) sgname='Bma2    '
   if (sgnum.eq. 39) sgname='C2mb    '
   if (sgnum.eq. 39) sgname='Ac2m    '
   if (sgnum.eq. 40) sgname='Ama2    '
   if (sgnum.eq. 40) sgname='B2mb    '
   if (sgnum.eq. 40) sgname='Cc2m    '
   if (sgnum.eq. 40) sgname='Bbm2    '
   if (sgnum.eq. 40) sgname='C2cm    '
   if (sgnum.eq. 40) sgname='Am2a    '
   if (sgnum.eq. 41) sgname='Aba2    '
   if (sgnum.eq. 41) sgname='B2cb    '
   if (sgnum.eq. 41) sgname='Cc2a    '
   if (sgnum.eq. 41) sgname='Bba2    '
   if (sgnum.eq. 41) sgname='C2cb    '
   if (sgnum.eq. 41) sgname='Ac2a    '
   if (sgnum.eq. 42) sgname='Fmm2    '
   if (sgnum.eq. 42) sgname='F2mm    '
   if (sgnum.eq. 42) sgname='Fm2m    '
   if (sgnum.eq. 43) sgname='Fdd2    '
   if (sgnum.eq. 43) sgname='F2dd    '
   if (sgnum.eq. 43) sgname='Fd2d    '
   if (sgnum.eq. 44) sgname='Imm2    '
   if (sgnum.eq. 44) sgname='I2mm    '
   if (sgnum.eq. 44) sgname='Im2m    '
   if (sgnum.eq. 45) sgname='Iba2    '
   if (sgnum.eq. 45) sgname='I2cb    '
   if (sgnum.eq. 45) sgname='Ic2a    '
   if (sgnum.eq. 46) sgname='Ima2    '
   if (sgnum.eq. 46) sgname='I2mb    '
   if (sgnum.eq. 46) sgname='Ic2m    '
   if (sgnum.eq. 46) sgname='Ibm2    '
   if (sgnum.eq. 46) sgname='I2cm    '
   if (sgnum.eq. 46) sgname='Im2a    '
   if (sgnum.eq. 47) sgname='Pmmm    '
   if (sgnum.eq. 48) sgname='Pnnn    '
   if (sgnum.eq. 49) sgname='Pccm    '
   if (sgnum.eq. 49) sgname='Pmaa    '
   if (sgnum.eq. 49) sgname='Pbmb    '
   if (sgnum.eq. 50) sgname='Pban    '
   if (sgnum.eq. 50) sgname='Pncb    '
   if (sgnum.eq. 50) sgname='Pcna    '
   if (sgnum.eq. 51) sgname='Pmma    '
   if (sgnum.eq. 51) sgname='Pbmm    '
   if (sgnum.eq. 51) sgname='Pmcm    '
   if (sgnum.eq. 51) sgname='Pmam    '
   if (sgnum.eq. 51) sgname='Pmmb    '
   if (sgnum.eq. 51) sgname='Pcmm    '
   if (sgnum.eq. 52) sgname='Pnna    '
   if (sgnum.eq. 52) sgname='Pbnn    '
   if (sgnum.eq. 52) sgname='Pncn    '
   if (sgnum.eq. 52) sgname='Pnan    '
   if (sgnum.eq. 52) sgname='Pnnb    '
   if (sgnum.eq. 52) sgname='Pcnn    '
   if (sgnum.eq. 53) sgname='Pmna    '
   if (sgnum.eq. 53) sgname='Pbmn    '
   if (sgnum.eq. 53) sgname='Pncm    '
   if (sgnum.eq. 53) sgname='Pman    '
   if (sgnum.eq. 53) sgname='Pnmb    '
   if (sgnum.eq. 53) sgname='Pcnm    '
   if (sgnum.eq. 54) sgname='Pcca    '
   if (sgnum.eq. 54) sgname='Pbaa    '
   if (sgnum.eq. 54) sgname='Pbcb    '
   if (sgnum.eq. 54) sgname='Pbab    '
   if (sgnum.eq. 54) sgname='Pccb    '
   if (sgnum.eq. 54) sgname='Pcaa    '
   if (sgnum.eq. 55) sgname='Pbam    '
   if (sgnum.eq. 55) sgname='Pmcb    '
   if (sgnum.eq. 55) sgname='Pcma    '
   if (sgnum.eq. 56) sgname='Pccn    '
   if (sgnum.eq. 56) sgname='Pnaa    '
   if (sgnum.eq. 56) sgname='Pbnb    '
   if (sgnum.eq. 57) sgname='Pbcm    '
   if (sgnum.eq. 57) sgname='Pmca    '
   if (sgnum.eq. 57) sgname='Pbma    '
   if (sgnum.eq. 57) sgname='Pcmb    '
   if (sgnum.eq. 57) sgname='Pcam    '
   if (sgnum.eq. 57) sgname='Pmab    '
   if (sgnum.eq. 58) sgname='Pnnm    '
   if (sgnum.eq. 58) sgname='Pmnn    '
   if (sgnum.eq. 58) sgname='Pnmn    '
   if (sgnum.eq. 59) sgname='Pmmn    '
   if (sgnum.eq. 59) sgname='Pnmm    '
   if (sgnum.eq. 59) sgname='Pmnm    '
   if (sgnum.eq. 60) sgname='Pbcn    '
   if (sgnum.eq. 60) sgname='Pnca    '
   if (sgnum.eq. 60) sgname='Pbna    '
   if (sgnum.eq. 60) sgname='Pcnb    '
   if (sgnum.eq. 60) sgname='Pcan    '
   if (sgnum.eq. 60) sgname='Pnab    '
   if (sgnum.eq. 61) sgname='Pbca    '
   if (sgnum.eq. 61) sgname='Pcab    '
   if (sgnum.eq. 62) sgname='Pnma    '
   if (sgnum.eq. 62) sgname='Pbnm    '
   if (sgnum.eq. 62) sgname='Pmcn    '
   if (sgnum.eq. 62) sgname='Pnam    '
   if (sgnum.eq. 62) sgname='Pmnb    '
   if (sgnum.eq. 62) sgname='Pcmn    '
   if (sgnum.eq. 63) sgname='Cmcm    '
   if (sgnum.eq. 63) sgname='Amma    '
   if (sgnum.eq. 63) sgname='Bbmm    '
   if (sgnum.eq. 63) sgname='Bmmb    '
   if (sgnum.eq. 63) sgname='Ccmm    '
   if (sgnum.eq. 63) sgname='Amam    '
   if (sgnum.eq. 64) sgname='Cmca    '
   if (sgnum.eq. 64) sgname='Abma    '
   if (sgnum.eq. 64) sgname='Bbcm    '
   if (sgnum.eq. 64) sgname='Bmab    '
   if (sgnum.eq. 64) sgname='Ccmb    '
   if (sgnum.eq. 64) sgname='Acam    '
   if (sgnum.eq. 65) sgname='Cmmm    '
   if (sgnum.eq. 65) sgname='Ammm    '
   if (sgnum.eq. 65) sgname='Bmmm    '
   if (sgnum.eq. 66) sgname='Cccm    '
   if (sgnum.eq. 66) sgname='Amaa    '
   if (sgnum.eq. 66) sgname='Bbmb    '
   if (sgnum.eq. 67) sgname='Cmma    '
   if (sgnum.eq. 67) sgname='Abmm    '
   if (sgnum.eq. 67) sgname='Bmcm    '
   if (sgnum.eq. 67) sgname='Bmam    '
   if (sgnum.eq. 67) sgname='Cmmb    '
   if (sgnum.eq. 67) sgname='Acmm    '
   if (sgnum.eq. 68) sgname='Ccca    '
   if (sgnum.eq. 68) sgname='Abaa    '
   if (sgnum.eq. 68) sgname='Bbcb    '
   if (sgnum.eq. 68) sgname='Bbab    '
   if (sgnum.eq. 68) sgname='Cccb    '
   if (sgnum.eq. 68) sgname='Acaa    '
   if (sgnum.eq. 69) sgname='Fmmm    '
   if (sgnum.eq. 70) sgname='Fddd    '
   if (sgnum.eq. 71) sgname='Immm    '
   if (sgnum.eq. 72) sgname='Ibam    '
   if (sgnum.eq. 72) sgname='Imcb    '
   if (sgnum.eq. 72) sgname='Icma    '
   if (sgnum.eq. 73) sgname='Ibca    '
   if (sgnum.eq. 73) sgname='Icab    '
   if (sgnum.eq. 74) sgname='Imma    '
   if (sgnum.eq. 74) sgname='Ibmm    '
   if (sgnum.eq. 74) sgname='Imcm    '
   if (sgnum.eq. 74) sgname='Imam    '
   if (sgnum.eq. 74) sgname='Immb    '
   if (sgnum.eq. 74) sgname='Icmm    '
   if (sgnum.eq. 75) sgname='P4      '
   if (sgnum.eq. 76) sgname='P41     '
   if (sgnum.eq. 77) sgname='P42     '
   if (sgnum.eq. 78) sgname='P43     '
   if (sgnum.eq. 79) sgname='I4      '
   if (sgnum.eq. 80) sgname='I41     '
   if (sgnum.eq. 81) sgname='P-4     '
   if (sgnum.eq. 82) sgname='I-4     '
   if (sgnum.eq. 83) sgname='P4/m    '
   if (sgnum.eq. 84) sgname='P42/m   '
   if (sgnum.eq. 85) sgname='P4/n    '
   if (sgnum.eq. 86) sgname='P42/n   '
   if (sgnum.eq. 87) sgname='I4/m    '
   if (sgnum.eq. 88) sgname='I41/a   '
   if (sgnum.eq. 89) sgname='P422    '
   if (sgnum.eq. 90) sgname='P4212   '
   if (sgnum.eq. 91) sgname='P4122   '
   if (sgnum.eq. 92) sgname='P41212  '
   if (sgnum.eq. 93) sgname='P4222   '
   if (sgnum.eq. 94) sgname='P42212  '
   if (sgnum.eq. 95) sgname='P4322   '
   if (sgnum.eq. 96) sgname='P43212  '
   if (sgnum.eq. 97) sgname='I422    '
   if (sgnum.eq. 98) sgname='I4122   '
   if (sgnum.eq. 99) sgname='P4mm    '
   if (sgnum.eq.100) sgname='P4bm    '
   if (sgnum.eq.101) sgname='P42cm   '
   if (sgnum.eq.102) sgname='P42nm   '
   if (sgnum.eq.103) sgname='P4cc    '
   if (sgnum.eq.104) sgname='P4nc    '
   if (sgnum.eq.105) sgname='P42mc   '
   if (sgnum.eq.106) sgname='P42bc   '
   if (sgnum.eq.107) sgname='I4mm    '
   if (sgnum.eq.108) sgname='I4cm    '
   if (sgnum.eq.109) sgname='I41md   '
   if (sgnum.eq.110) sgname='I41cd   '
   if (sgnum.eq.111) sgname='P-42m   '
   if (sgnum.eq.112) sgname='P-42c   '
   if (sgnum.eq.113) sgname='P-421m  '
   if (sgnum.eq.114) sgname='P-421c  '
   if (sgnum.eq.115) sgname='P-4m2   '
   if (sgnum.eq.116) sgname='P-4c2   '
   if (sgnum.eq.117) sgname='P-4b2   '
   if (sgnum.eq.118) sgname='P-4n2   '
   if (sgnum.eq.119) sgname='I-4m2   '
   if (sgnum.eq.120) sgname='I-4c2   '
   if (sgnum.eq.121) sgname='I-42m   '
   if (sgnum.eq.122) sgname='I-42d   '
   if (sgnum.eq.123) sgname='P4/mmm  '
   if (sgnum.eq.124) sgname='P4/mcc  '
   if (sgnum.eq.125) sgname='P4/nbm  '
   if (sgnum.eq.126) sgname='P4/nnc  '
   if (sgnum.eq.127) sgname='P4/mbm  '
   if (sgnum.eq.128) sgname='P4/mnc  '
   if (sgnum.eq.129) sgname='P4/nmm  '
   if (sgnum.eq.130) sgname='P4/ncc  '
   if (sgnum.eq.131) sgname='P42/mmc '
   if (sgnum.eq.132) sgname='P42/mcm '
   if (sgnum.eq.133) sgname='P42/nbc '
   if (sgnum.eq.134) sgname='P42/nnm '
   if (sgnum.eq.135) sgname='P42/mbc '
   if (sgnum.eq.136) sgname='P42/mnm '
   if (sgnum.eq.137) sgname='P42/nmc '
   if (sgnum.eq.138) sgname='P42/ncm '
   if (sgnum.eq.139) sgname='I4/mmm  '
   if (sgnum.eq.140) sgname='I4/mcm  '
   if (sgnum.eq.141) sgname='I41/amd '
   if (sgnum.eq.142) sgname='I41/acd '
   if (sgnum.eq.143) sgname='P3      '
   if (sgnum.eq.144) sgname='P31     '
   if (sgnum.eq.145) sgname='P32     '
   if (sgnum.eq.146) sgname='R3      '
   if (sgnum.eq.147) sgname='P-3     '
   if (sgnum.eq.148) sgname='R-3     '
   if (sgnum.eq.149) sgname='P312    '
   if (sgnum.eq.150) sgname='P321    '
   if (sgnum.eq.151) sgname='P3112   '
   if (sgnum.eq.152) sgname='P3121   '
   if (sgnum.eq.153) sgname='P3212   '
   if (sgnum.eq.154) sgname='P3221   '
   if (sgnum.eq.155) sgname='R32     '
   if (sgnum.eq.156) sgname='P3m1    '
   if (sgnum.eq.157) sgname='P31m    '
   if (sgnum.eq.158) sgname='P3c1    '
   if (sgnum.eq.159) sgname='P31c    '
   if (sgnum.eq.160) sgname='R3m     '
   if (sgnum.eq.161) sgname='R3c     '
   if (sgnum.eq.162) sgname='P-31m   '
   if (sgnum.eq.163) sgname='P-31c   '
   if (sgnum.eq.164) sgname='P-3m1   '
   if (sgnum.eq.165) sgname='P-3c1   '
   if (sgnum.eq.166) sgname='R-3m    '
   if (sgnum.eq.167) sgname='R-3c    '
   if (sgnum.eq.168) sgname='P6      '
   if (sgnum.eq.169) sgname='P61     '
   if (sgnum.eq.170) sgname='P65     '
   if (sgnum.eq.171) sgname='P62     '
   if (sgnum.eq.172) sgname='P64     '
   if (sgnum.eq.173) sgname='P63     '
   if (sgnum.eq.174) sgname='P-6     '
   if (sgnum.eq.175) sgname='P6/m    '
   if (sgnum.eq.176) sgname='P63/m   '
   if (sgnum.eq.177) sgname='P622    '
   if (sgnum.eq.178) sgname='P6122   '
   if (sgnum.eq.179) sgname='P6522   '
   if (sgnum.eq.180) sgname='P6222   '
   if (sgnum.eq.181) sgname='P6422   '
   if (sgnum.eq.182) sgname='P6322   '
   if (sgnum.eq.183) sgname='P6mm    '
   if (sgnum.eq.184) sgname='P6cc    '
   if (sgnum.eq.185) sgname='P63cm   '
   if (sgnum.eq.186) sgname='P63mc   '
   if (sgnum.eq.187) sgname='P-6m2   '
   if (sgnum.eq.188) sgname='P-6c2   '
   if (sgnum.eq.189) sgname='P-62m   '
   if (sgnum.eq.190) sgname='P-62c   '
   if (sgnum.eq.191) sgname='P6/mmm  '
   if (sgnum.eq.192) sgname='P6/mcc  '
   if (sgnum.eq.193) sgname='P63/mcm '
   if (sgnum.eq.194) sgname='P63/mmc '
   if (sgnum.eq.195) sgname='P23     '
   if (sgnum.eq.196) sgname='F23     '
   if (sgnum.eq.197) sgname='I23     '
   if (sgnum.eq.198) sgname='P213    '
   if (sgnum.eq.199) sgname='I213    '
   if (sgnum.eq.200) sgname='Pm-3    '
   if (sgnum.eq.201) sgname='Pn-3    '
   if (sgnum.eq.202) sgname='Fm-3    '
   if (sgnum.eq.203) sgname='Fd-3    '
   if (sgnum.eq.204) sgname='Im-3    '
   if (sgnum.eq.205) sgname='Pa-3    '
   if (sgnum.eq.206) sgname='Ia-3    '
   if (sgnum.eq.207) sgname='P432    '
   if (sgnum.eq.208) sgname='P4232   '
   if (sgnum.eq.209) sgname='F432    '
   if (sgnum.eq.210) sgname='F4132   '
   if (sgnum.eq.211) sgname='I432    '
   if (sgnum.eq.212) sgname='P4332   '
   if (sgnum.eq.213) sgname='P4132   '
   if (sgnum.eq.214) sgname='I4132   '
   if (sgnum.eq.215) sgname='P-43m   '
   if (sgnum.eq.216) sgname='F-43m   '
   if (sgnum.eq.217) sgname='I-43m   '
   if (sgnum.eq.218) sgname='P-43n   '
   if (sgnum.eq.219) sgname='F-43c   '
   if (sgnum.eq.220) sgname='I-43d   '
   if (sgnum.eq.221) sgname='Pm-3m   '
   if (sgnum.eq.222) sgname='Pn-3n   '
   if (sgnum.eq.223) sgname='Pm-3n   '
   if (sgnum.eq.224) sgname='Pn-3m   '
   if (sgnum.eq.225) sgname='Fm-3m   '
   if (sgnum.eq.226) sgname='Fm-3c   '
   if (sgnum.eq.227) sgname='Fd-3m   '
   if (sgnum.eq.228) sgname='Fd-3c   '
   if (sgnum.eq.229) sgname='Im-3m   '
   if (sgnum.eq.230) sgname='Ia-3d   '

   if (sgname.eq.'        ') then
      write(*,'(a,i4)') 'unknown space group number:',sgnum
      stop
   endif

 end subroutine getsgrhm


      subroutine clearfp
!
!     This is a null version of a
!     subroutine to clear IEEE floating point exceptions
!     for inexact and underflow under SUN OS 4 f77
!     For most other systems, no action is needed.
!
!     character*1 out
!     ii = ieee_flags('clear','exception','underflow',out)
!     ii = ieee_flags('clear','execption','inexact',out)
      return
      end

!
!       hash_funcs.f -- a library of hash table management routines
!
!                                      by
!
!                              Herbert J. Bernstein
!                                Bernstein + Sons
!                    5 Brewster Lane, Bellport, NY 11713-0177, USA
!                       email: yaya@bernstein-plus-sons.com
!
!       work on these routines done in part at Brookhaven National
!       Laboratory, under contract to the U.S. Department of Energy
!
!       work on these routines as been done in part at Dowling College 
!       under contract to the International Union of Crystallography 
!       and under grants from the National Science Foundation and 
!       the U.S. Department of Energy.
!
!       Copyright (C) Herbert J. Bernstein 1997 -- 2006
!
!       hash_funcs.f is free software; you can redistribute this software 
!       and/or modify this software under the terms of the GNU General 
!       Public License as published by the Free Software Foundation; 
!       either version 2 of the License, or (at your option) any later version.
!
!       Alternatively you may reditribute and/or modify hash_funcs.f
!       under the terms of the GNU Lesser General Public 
!       License as published by the Free Software Foundation; either 
!       version 2.1 of the License, or (at your option) any later version.
!
!       This software is distributed in the hope that it will be useful,
!       but WITHOUT ANY WARRANTY; without even the implied warranty of
!       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!       GNU General Public License for more details.
!
!       You should have received a copy of the GNU General Public License
!       along with this software; if not, write to the Free Software
!       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!       You should have received a copy of the GNU Lesser General Public License
!       along with this software; if not, write to the Free Software
!       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
!
!-------------------------------------------------------------------------------
!
!       Routines
!
!       hash_init          Initializes a hash table controlled list
!                          call hash_init(data_structure_args)
!
!       hash_find          Searches for a string in a list
!                          call hash_find(name,data_structure_args,ifind)
!
!       hash_fnext         Searches for the next matching string in a list
!                          call hash_fnext(name,data_structure_args,ifind,icurr)
!
!       hash_store         Inserts a new string in a list
!                          call hash_store(name,data_structure_args,ifind)
!
!       hash_snext         Inserts a string in a list, allowing duplicates
!                          call hash_store(name,data_structure_args,ifind,icurr)
!
!       hash_value         Integer function returns index into hash_list
!                          ih = hash_value(name,hash_length)
!
!       The necessary data_structure_args for these routines are
!          name_list   -- an array of character strings
!                         character*(*) name_list(list_length)
!          chain_list  -- chain pointers for searches
!                         integer chain_list(list_length)
!          list_length -- the size of the list arrays
!                         integer list_length
!          num_list    -- number of entries in the list
!                         integer num_list
!          hash_table  -- the initial hashed pointers
!                         integer hash_table
!          hash_length -- the size of the hash table
!                         integer hash_length
!
!
!       The three remaining arguments are
!          name        -- string to search for
!                         character*(*) name
!          ifind       -- return value, 0 for not found (hash_find)
!                         or list full (hash_store), otherwise
!                         the index in name_list of the entry
!          icurr       -- the prior matching index
!
!       The relationship among the arrays used is:
!
!       hash_table is an array (preferably of a modest prime
!       dimension) which starts containing all zeros, which are
!       replaced by pointers to entries in name_list, based
!       values returned by hash_value ranging from 1 to hash_length.
!       Each name is placed in name_list.  A initial zero is placed
!       in the matching entry in chain_list, when the first entry
!       is made.  When a new entry with the same hash_value must be
!       placed a pointer is inserted into chain_list to hook the
!       values together.
!
        subroutine hash_init(name_list,chain_list,list_length,num_list, &
     &                       hash_table,hash_length)
!
!       initialization routine for a hash table controlled list
!          name_list   -- a list of character strings
!          chain_list  -- chain pointers for searches
!          list_length -- the size of the list arrays
!          num_list    -- number of entries in the list
!          hash_table  -- the initial hashed pointers
!          hash_length -- the size of the hash table
!
           integer list_length
           character*(*) name_list(list_length)
           integer hash_length,num_list,i
           integer chain_list(list_length)
           integer hash_table(hash_length)
           num_list=0
           do i = 1,hash_length
           hash_table(i)=0
           enddo
           return
           end          

        subroutine                                                      &
     &  hash_find(name,name_list,chain_list,list_length,num_list,       &
     &                       hash_table,hash_length,ifind)
!
!       search routine for a hash table controlled list
!          name        -- string to find
!          name_list   -- a list of character strings
!          chain_list  -- chain pointers for searches
!          list_length -- the size of the list arrays
!          num_list    -- number of entries in the list
!          hash_table  -- the initial hashed pointers
!          hash_length -- the size of the hash table
!          ifind       -- returned index or 0
!
           character*(*) name
           integer list_length, hash_length
           integer lenn
           character*(*) name_list(list_length)
           integer chain_list(list_length)
           integer hash_table(hash_length)
           integer hash_value
           integer ifind,num_list,ih,ip
           integer lastnb
           ifind=0
           ih=hash_value(name,hash_length)
           ip=hash_table(ih)
           lenn = lastnb(name)
 100       if (ip.eq.0) return
           if (name_list(ip).eq.name(1:lenn)) then
             ifind=ip
             return
           else
             ip=chain_list(ip)
             go to 100
           endif
           end
           
        subroutine                                                      &
     &  hash_fnext(name,name_list,chain_list,list_length,num_list,      &
     &                       hash_table,hash_length,ifind,icurr)
!
!       search routine for a hash table controlled list
!          name        -- string to find
!          name_list   -- a list of character strings
!          chain_list  -- chain pointers for searches
!          list_length -- the size of the list arrays
!          num_list    -- number of entries in the list
!          hash_table  -- the initial hashed pointers
!          hash_length -- the size of the hash table
!          ifind       -- returned index or 0
!          icurr       -- current match or 0
!
           character*(*) name
           integer hash_length
           integer list_length
           integer lenn
           character*(*) name_list(list_length)
           integer chain_list(list_length)
           integer hash_table(hash_length)
           integer hash_value
           integer ifind,num_list,ih,ip
           integer lastnb
           integer icurr
           
           ifind=0
           if (icurr.eq.0) then
             ih = hash_value(name,hash_length)
             ip = hash_table(ih)
           else
             ip = chain_list(icurr)
           endif
           lenn = lastnb(name)
 100       if (ip.eq.0) return
           if (name_list(ip).eq.name(1:lenn)) then
             ifind=ip
             return
           else
             ip=chain_list(ip)
             go to 100
           endif
           end

        subroutine                                                      &
     &  hash_store(name,name_list,chain_list,list_length,num_list,      &
     &                       hash_table,hash_length,ifind)
!
!       store routine for a hash table controlled list
!          name        -- string to find
!          name_list   -- a list of character strings
!          chain_list  -- chain pointers for searches
!          list_length -- the size of the list arrays
!          num_list    -- number of entries in list
!          hash_table  -- the initial hashed pointers
!          hash_length -- the size of the hash table
!          ifind       -- index of entry or 0 (table full)
!
           integer list_length
           character*(*) name
           character*(*) name_list(list_length)
           integer hash_length
           integer lenn
           integer chain_list(list_length)
           integer hash_table(hash_length)
           integer hash_value
           integer ifind,num_list,ih,ip,iq
           integer lastnb

           ifind=0
           ih = hash_value(name,hash_length)
           ip=hash_table(ih)
           iq=0
           lenn = lastnb(name)
 100       if (ip.eq.0) go to 200
           if (name_list(ip).eq.name(1:lenn)) then
             ifind=ip
             return
           else
             iq=ip
             ip=chain_list(ip)
             go to 100
           endif
 200       if (num_list.lt.list_length) then
             num_list=num_list+1
             name_list(num_list)=name(1:lenn)
             chain_list(num_list)=0
             if (iq.eq.0) then
               hash_table(ih)=num_list
             else
               chain_list(iq)=num_list
             endif
             ifind=num_list
             return
           else
             ifind = 0
             return
           endif
           end


        subroutine                                                      &
     &  hash_snext(name,name_list,chain_list,list_length,num_list,      &
     &                       hash_table,hash_length,ifind,icurr)
!
!       store routine for a hash table controlled list
!          name        -- string to find
!          name_list   -- a list of character strings
!          chain_list  -- chain pointers for searches
!          list_length -- the size of the list arrays
!          num_list    -- number of entries in list
!          hash_table  -- the initial hashed pointers
!          hash_length -- the size of the hash table
!          ifind       -- index of entry or 0 (table full)
!          icurr       -- current match or 0
!
           integer list_length
           character*(*) name
           character*(*) name_list(list_length)
           integer hash_length
           integer lenn
           integer chain_list(list_length)
           integer hash_table(hash_length)
           integer hash_value
           integer ifind,num_list,ih,ip,iq
           integer lastnb
           integer icurr

           ifind=0
           ih = 0
           if (icurr.eq.0) then
             ih = hash_value(name,hash_length)
             ip=hash_table(ih)
             iq = 0
           else
             ip = chain_list(icurr)
             iq = icurr
           endif
           lenn = lastnb(name)
 100       if (ip.eq.0) go to 200
           if (name_list(ip).eq.name(1:lenn)) then
             ifind=ip
             return
           else
             iq=ip
             ip=chain_list(ip)
             go to 100
           endif
 200       if (num_list.lt.list_length) then
             num_list=num_list+1
             name_list(num_list)=name(1:lenn)
             chain_list(num_list)=0
             if (iq.eq.0) then
               hash_table(ih)=num_list
             else
               chain_list(iq)=num_list
             endif
             ifind=num_list
             return
           else
             ifind = 0
             return
           endif
           end

      integer function hash_value(name,hash_length)
!
!     function to return a hash value of string name to fit
!     a hash table of length hash_length
      character*(*) name
      integer lastnb
      
      integer hash_length,id,ii,i,ic,lenn
      lenn = lastnb(name)
      hash_value=1
      id = 0
      do ii = 1,lenn
        i = 1+lenn-ii
        ic = ichar(name(i:i))
        if (ic.ge.65) then
          hash_value=mod(hash_value*(ic-64),hash_length)+1
          id = id+1
          if (id.gt.3) return
        endif
      enddo
      return
      end
        

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: nxtunt.f90,v $:
! $Revision: 1.2 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!====================================================================
      integer function nxtunt(iunit)

!  this function returns the value of the next unopened unit number
!  equal to or larger than iunit.  it will return neither unit numbers
!  0, 5, or 6 nor a negative unit number
! $Id: nxtunt.f90,v 1.2 2010/02/23 23:52:06 hebhop Exp $
! $Log: nxtunt.f90,v $
! Revision 1.2  2010/02/23 23:52:06  hebhop
! Added header to all .f90 files to show version info, i.e. date, author, revision number of last modification.
!
! Revision 1.1  2007/12/08 08:06:16  hebhop
! Lots of changes.
!
! 1. Changed all filenames to *.f90
! 2. Changed Makefile to compile all files directly instead of making recursively.
! 3. Added DEP directory and dependency files.
! 4. Added Utilities to make dependency files. Note: these probably aren't robust and should be rewritten.
! 5. Added I/O modules and Error modules.
! 6. Changed a few routines to use I/O modules.
! 7. Split atomic calculation from SCF potentials calculation.
!    Atomic calculations now calculate things for all edges.
! 8. Added hack (soon to be option) to read muffin tin potentials from external file.
!
! Revision 1.1.1.1  2007/10/23 22:07:50  ytakimot
!
! FEFF9 Project
!
! Revision 1.1.1.1  2007/06/04 23:16:47  hebhop
! Initializing feff86. All references to so2conv have changed to sfconv
! Josh Kas
!
! Revision 1.1.1.1  2006/01/12 06:37:42  hebhop
! New version of feff. feff8.5 (Extension of feff8.4)
! Includes:
! 	1) All feff8.4 capabilities.
! 	2) Screened core hole (calculation of W).
! 	3) Multiple pole self energy calculation.
! 	4) Convolution with spectral function.
! New cards and options:
! 	1) NOHOLE 2      (screened hole)
! 	2) PLASMON ipl   (multiple pole self energy)
! 	3) SO2CONV       (convolve output with spectral function)
! 	4) SELF          (print on shell self energy as calculated by Luke)
! 	5) SFSE k0        (print off shell self energy Sigma(k0,e) )
!
! Revision 1.1.1.1  2000/02/11 02:23:58  alex
! Initialize feff82
!
! Revision 1.10  1999/04/02 21:32:47  newville
! cleaned up nxtunt (matt)
!
! Revision 1.9  1999/02/11 20:08:08  alex
! x39 version: dim.h + misc. small changes
!
! Revision 1.8  1998/12/29 23:59:07  alex
! feff8x35 version
!
! Revision 1.7  1998/11/19 03:23:11  alex
! feff8x32 version
!
! Revision 1.6  1998/10/26 14:11:16  ravel
! no comments beyond column 71
!
! Revision 1.5  1998/10/18 21:47:51  alex
! feff8x30 version implements Broyden algorithm for self-consistency
!
! Revision 1.4  1998/02/24 18:31:37  ravel
! I should really be more careful.  This is the last commitment done
!      cright.
!
! Revision 1.1.1.1  1997/04/27 20:18:03  ravel
! Initial import of xanes sources, version 0.37
!
! Revision 1.1  1996/06/23 16:05:02  bruce
! Initial revision
!

       integer iunit
       logical open

       nxtunt = max(1, iunit) - 1
 10    continue
       nxtunt = nxtunt + 1
       if ((nxtunt.eq.5).or.(nxtunt.eq.6)) nxtunt = 7
       inquire (unit=nxtunt, opened=open)
       if (open) go to 10
       return
!  end integer function nxtunt
       end

!====================================================================

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Information about last revision of $RCSfile: rdhead.f90,v $:
! $Revision: 1.3 $
! $Author: hebhop $
! $Date: 2010/02/23 23:52:06 $
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      subroutine rdhead (io, nhead, head, lhead)
      implicit double precision (a-h, o-z)

!     Reads title line(s) from unit io.  Returns number of lines
!     read.  If more than nheadx lines, skips over them.  End-of-header
!     marker is a line of 1 blank, 71 '-'s.
!     lhead is length of each line w/o trailing blanks.
!     header lines returned will have 1st space on line blank for
!     carriage control

      character*80 head(nhead)
      dimension lhead(nhead)
      character*80  line
      integer istrln
      external istrln

      n = 0
      nheadx = nhead
      nhead = 0
   10 read(io,20)  line
   20    format(a)
         if (line(4:11) .eq. '--------')  goto 100
         n = n+1
         if (n .le. nheadx)  then
            head(n) = line
            lhead(n) = istrln(head(n))
            nhead = n
         endif
      goto 10
  100 continue
      return
      end

