       program cif2pdb
C
C      program for conversion of an mmCIF data set to a pseudo-PDB
C      entry
C
C      Version 1.0.1 17 June 1998
C
C      Herbert J. Bernstein
C      Bernstein+Sons
C      5 Brewster Lane
C      Bellport, NY 11713-2803
C      phone:  1-516-286-1339   email:  yaya@bernstein-plus-sons.com
C
C      Frances C. Bernstein
C      Bernstein+Sons
C      5 Brewster Lane
C      Bellport, NY 11713-2803
C      phone:  1-516-286-1339   email:  fcb@bernstein-plus-sons.com
C
C      This program is a version 1.0.1 of cif2pdb, capable of doing
C      a conversion of an mmCIF data set to a partial pseudo-PDB entry
C      with HEADER, TITLE, COMPND, SOURCE, KEYWRD, AUTHOR, JRNL,
C      REMARK 1, REMARK 960, SEQRES, CRYST1, ORIGX, SCALE, ATOM, 
C      ANISOU, SIGUIJ (starting with U's or B's), HETATM, MASTER 
C      and END records.  Fractional or orthogonal coordinates
C      may be provided in the mmCIF data set.  If an mmCIF dictionary
C      or other dictionary with the necessary aliases between mmCIF
C      and the core is provided, the program can convert core CIF
C      data sets.  This is sufficient to drive RASMOL.
C
C      Comments to yaya@bernstein-plus-sons.com appreciated.
C
       include 'cif2pdb.cmn'
       logical init_
       logical ocif_
       logical dict_
       logical data_
       logical findtag_
C

C
C      Initialization of variables
C
       iunpdb = 6
       iuninp = 11
       iunout = 6
       iundac = 13
       iunerr = 0
       pdbline = 0
       pdbrec = ' '
       type_code = 'l'
       call splitstr(num_aa,
     *   "ALA,ARG,ASN,ASP,CYS,GLN,GLU,GLY,HIS,ILE,LEU,LYS,"//
     *   "MET,PHE,PRO,SER,THR,TRP,TYR,VAL,ASX,GLX,UNK",
     *   aa_list,23,',')
       call splitstr(num_na,
     *   "A  ,C  ,G  ,T  ,U  ,I  ,+A ,+C ,+G ,+T ,+U ,+I ",
     *   na_list,12,',')
       call hash_init(mapstr,mapchain,
     *   NUMSTR,nmap,mhash,NUMHSH)
       result = init_(iuninp,iunout,iundac,iunerr)
       call getfiles
       if (ckdict(1:lckdict).ne.' ')
     *   result = dict_(ckdict(1:lckdict),'valid dtype catck')
       if (inpcif(1:linpcif).eq.'-' .or. 
     *   inpcif(1:linpcif) .eq. ' ') then
         iuninp = 5
         inpcif = ' '
         result = init_(iuninp,iunout,iundac,iunerr)
       endif
       if (outent(1:loutent).eq.'-') outent = ' '
       result = ocif_(inpcif(1:linpcif))
       if(.not.result) then
         call c2perr(
     *   ' failed to open '//inpcif(1:linpcif))
       endif
       if (outent(1:1) .ne. ' ')
     * open(unit=iunpdb,file=outent(1:loutent),status='unknown')
       result = data_(' ')
       if (.not.result) then
         call c2perr(' failed to open block')
       endif
       pdbent = bloc_
         call c2pmsg(' ',' Data Block Name '//pdbent)
       numRemark = 0
       numFtnote = 0
       numHet = 0
       numHelix = 0
       numSheet = 0
       numTurn = 0
       numSite = 0
       numXform = 0
       numCoord = 0
       numTer = 0
       numConect = 0
       numSeq = 0
       numTitle = 0
       numCompound = 0
       numSource = 0
       numCaveat = 0 
       call get_hets
       call get_chains
       call proc_header
       call proc_title
       call proc_keywds
       call proc_expdta
       call proc_author
       call proc_remark
       result = findtag_('_entity_poly_seq.entity_id')
       call proc_seqres
       if (.not.result)
     *    result = findtag_('_cell.length_a')
       call proc_cryst1
       call proc_origx
       call proc_scale
       call proc_atom
       call proc_master
       stop
       end
      subroutine getfiles
C
      include 'cif2pdb.cmn'
      logical dict_
      character*256 temp,temp2,cline
      integer iargc,kkinp,kkout,kkdict
      logical backarg,ffile
      myentry = '*???'
      numarg = iargc()
      call getenv("CIF2PDB_INPUT_CIF",inpcif)
      call getenv("CIF2PDB_OUTPUT_ENTRY",outent)
      call getenv("CIF2PDB_CHECK_DICTIONARY",ckdict)
      karg = 0
      iwant = 0
      ifound = 0
      isi = 0
      iso = 0       
      backarg = .false.
      ffile = .false.
 100  if(.not.ffile) then
        karg = karg+1
        if (karg.le.numarg) then
          if (.not.backarg) then
            call getarg(karg,temp)
            temp2 = ' '
          else
            temp = temp2
            backarg = .false.
          endif
        else
          go to 500
        endif
      else
        go to 300
 200    close(unit=iuninp)
        ffile = .false.
        go to 100
 300    kfarg = kfarg+1
        if (kfarg.gt.nfarg) then
          read(iuninp,'(a)',end=200) cline
          call splitstr(nfarg,cline,cstr,128,' ')
          kfarg = 0
          go to 300
        else
          if (.not.backarg) then
            temp = cstr(kfarg)
            temp2 = ' '
          else
            temp = temp2
            backarg = .false.
          endif
        endif
      endif
      ll = nblen(temp)
      if (ll.eq.0) then
        temp = ' '
        ll = 1
      endif
      if (iwant.ne.0) then
        if (iwant.eq.1) inpcif = temp(1:ll)
        if (iwant.eq.2) outent = temp(1:ll)
        if (iwant.eq.3) then
          ckdict = temp(1:ll)
          lckdict = max(1,nblen(ckdict))
          result = dict_(ckdict(1:lckdict),"valid dtype catck")
          ckdict = " "
          lckdict = 1
        endif
        if (iwant.eq.4) myentry = upcase(temp(1:ll))
        if (iwant.eq.5) then
          open(unit=iuninp,file=temp(1:ll),status='OLD',err=900)
          kfarg = 1
          nfarg = 0
          ffile = .true.
        endif
        if (iwant.eq.6) then
          kpmap = nmap
          temp = nounder(temp(1:ll))
          ll = nblen(temp)
          call hash_store(temp(1:ll)//char(0),mapstr,mapchain,
     *      NUMSTR,nmap,mhash,NUMHSH,ifrom)
          if (ifrom.eq.0)
     *      call c2perr(' More than NUMSTR strings mapped ')
          if (ifrom.ne.kpmap+1)
     *      call c2pwarn(' Duplicate mapping of '//temp(1:ll))
          iwant = 7
          go to 100
        endif
        if (iwant.eq.7) then
          kpmap = nmap
          temp = nounder(temp(1:ll))
          ll = nblen(temp)
          call hash_store(temp(1:ll)//char(0),mapstr,mapchain,
     *      NUMSTR,nmap,mhash,NUMHSH,ito)
          if (ito.eq.0) 
     *      call c2perr(' More than NUMSTR strings mapped ')
          if (ito.eq.kpmap+1) mapto(ito) = 0
          mapto(ifrom) = ito
        endif
        if (iwant.eq.8) then
          if(temp(1:ll).eq."u" .or.
     *      temp(1:ll).eq."l" .or.
     *      temp(1:ll).eq."p" ) then
            type_code = temp(1:1)
          else
            go to 900
          endif
        endif
        iwant = 0
      else
        if (temp(1:1).eq."-") then
          temp2=temp(3:256)
          if (ll.gt.2) then
            backarg = .true.
            karg = karg-1
          endif
          if (temp(2:2).eq."i") then
            iwant = 1
            if (isi.gt.0) go to 900
            isi = 1
          endif
          if (temp(2:2).eq."o") then
            iwant = 2
            if (iso.gt.0) go to 900
            iso = 1
          endif
          if (temp(2:2).eq."d") iwant = 3
          if (temp(2:2).eq."p") iwant = 4
          if (temp(2:2).eq."f") iwant = 5
          if (temp(2:2).eq."m") iwant = 6
          if (temp(2:2).eq."t") iwant = 8
          if (iwant.eq.0) go to 900
        else
          ifound = ifound+1
          if (ifound.eq.1) then
            if (isi.gt.0) then
              ifound = ifound+1
            else
              inpcif = temp(1:ll)
              isi = 1
            endif
          endif
          if (ifound.eq.2) then
            if (iso.gt.0) then
              ifound = ifound+1
            else
              outent = temp(1:ll)
              iso = 1
            endif
          endif
          if (ifound.eq.3) then
            ckdict = temp(1:ll)
          endif
          if (ifound.gt.3) go to 900
        endif
      endif
      go to 100
 500  linpcif = max(1,nblen(inpcif))
      loutent = max(1,nblen(outent))
      lckdict = max(1,nblen(ckdict))
      return
 900  write(iunerr,'(a)')
     *  ' cif2pdb [-i input_cif] [-o output_entry] [-d dictionary]',
     *  '         [-p pdb_entry_id] [-f command_file] [-t u|l|p]',
     *  '         [-m string_in_cif string_in_pdb] [[[input_cif]',
     *  '         [[output_entry] [dictionary]]]',
     *  ' input_cif defaults to $CIF2PDB_INPUT_CIF or stdin',
     *  ' output_cif defaults to $CIF2PDB_OUTPUT_ENTRY or stdout',
     *  ' dictionary defaults to $CIF2PDB_CHECK_DICTIONARY',
     *  ' multiple dictionaries may be specified ',
     *  ' input_cif of "-" is stdin, output_entry of "-" is stdout',
     *  ' -t has values of u for upper case, l for upper/lower,',
     *  '    p for PDB typesetting codes, (default -t l)'
       stop
       end

       subroutine get_hets
       include 'cif2pdb.cmn'
       character*9 curcat
       character*10 yesno
       logical findtag_
       logical result_blk
       logical result_id
       logical result_mon_nstd_flag
       curcat = 'chem_comp'
       numhetl = 0
       result_blk = findtag_('_chem_comp.id')
       if (.not.result_blk) return
       loop_ = .false.
 100   result_id = pdbstr(curcat,'id',3,hetl(numhetl+1))
       if(result_id) then
         result_mon_nstd_flag = pdbstr(curcat,'mon_nstd_flag',10,yesno)
         if(result_mon_nstd_flag.and.
     *     (yesno(1:1).ne.'n' .and. 
     *      yesno(1:1).ne.'N' .and.
     *      yesno(1:1).ne.' ')) then
           numhetl = numhetl+1
         else
           if(.not.result_mon_nstd_flag .or.
     *        (result_mon_nstd_flag.and.yesno(1:1).eq.' ')) then
             do ii = 1,num_aa
               if (hetl(numhetl+1) .eq. aa_list(ii) ) go to 120
             enddo
             do ii = 1,num_na
               if (hetl(numhetl+1) .eq. na_list(ii) ) go to 120
             enddo
             numhetl = numhetl+1
           endif
         endif
       endif
 120   if (loop_) go to 100
       return
       end
       subroutine get_chains
       include 'cif2pdb.cmn'
       character*33 long_name,entities(127)
       character*12 entity_type(127)
       logical result_id
       logical result_entity_id
       logical result_type
       logical result_entity
       logical ispoly
       num_ent = 0
       num_chains = 0
       loop_ = .false.
 100   result_entity = pdbstr('entity','id',33,
     *   entities(num_ent+1))
       result_type = pdbstr('entity','type',12,
     *   entity_type(num_ent+1))
       if(result_entity .and. result_type) then
         num_ent = num_ent+1
       endif
       if (loop_) go to 100
 200   result_entity_id = pdbstr('struct_asym','entity_id',33,
     *   entity_list(num_chains+1))
       if (result_entity_id) then
         ispoly = .true.
         do ii = 1,num_ent
         if (entity_list(num_chains+1).eq.
     *     entities(ii)) then
           if (entity_type(ii)(1:1).ne.'P' .and.
     *       entity_type(ii)(1:1).ne.'p') ispoly = .false.
           go to 300
         endif
         enddo
 300     if (ispoly) then
           result_id = pdbstr('struct_asym','id',3,
     *       chain_list(num_chains+1))
           if(result_id) then
             num_chains = num_chains+1
           endif
         endif
       endif
       if (loop_) go to 200
       return
       end
       subroutine proc_atom
C
C      process and atom list
C
       include 'cif2pdb.cmn'
       character*9 curcat
       logical result_group_PDB,result_id,
     *    result_label_atom_id,
     *    result_label_alt_id,result_label_comp_id,
     *    result_label_asym_id,result_label_seq_id,
     *    result_auth_asym_id,
     *    result_cartn_x,result_cartn_y,result_cartn_z,
     *    result_fract_x,result_fract_y,result_fract_z,
     *    result_occupancy,result_B_iso_or_equiv,
     *    result_footnote_id,result_type_symbol,
     *    result_label_model_id,
     *    result_aniso_U(6),
     *    result_aniso_Usd(6),
     *    doanisou, dosiguij
       character*6 group_PDB
       character*5 idstr,oidstr
       character*4 label_atom_id
       character*1 label_alt_id
       character*3 label_comp_id
       character*1 label_asym_id
       character*4 auth_asym_id
       character*5 label_seq_id
       character*8 xstr,ystr,zstr
       character*4 modstr
       character*6 occstr,Bstr
       character*3 fidstr
       character*12 anistr(6)
       character*12 anisdstr(6)
       real cartn_x,cartn_y,cartn_z,occupancy,B_iso_or_equiv
       real fract_xyz(3)
       real aniso(6),anisd(6)
       logical fcoord
       integer ianiso(6),ianisd(6)
       integer footnote_id,modnum,pmodnum
       character*4 type_symbol
       character*5 blanks
       integer ic, lstart
       data blanks/'     '/
       data pi/3.1415926536/
       curcat = 'atom_site'
       pdbrec = 'ATOM'
       pmodnum = -9999
       text_= .false.
       fcoord = .false.
       lstart = pdbline
C
 100   pdbline = pdbline+1
       result_group_PDB = pdbstr(curcat,'group_PDB',6,group_PDB)
       result_id = pdbint(curcat,'id',5,idstr,id)
       oidstr = idstr
       call rjust(idstr)
       if (.not.result_id.or.id.eq.0) then
         id = mod(pdbline-lstart,100000)
         write (idstr,'(i5)') id
       endif
       result_label_atom_id = pdbstr(curcat,'label_atom_id',4,
     *   label_atom_id)
       result_label_alt_id = pdbstr(curcat,'label_alt_id',1,
     *   label_alt_id)
       result_label_comp_id = pdbstr(curcat,'label_comp_id',3,
     *   label_comp_id)
       result_label_asym_id = pdbstr(curcat,'label_asym_id',1,
     *   label_asym_id)
       result_auth_asym_id = pdbstr(curcat,'auth_asym_id',4,
     *   auth_asym_id)
       ll=nblen(auth_asym_id)
       tmparg(1:max(1,ll))=auth_asym_id
       if(ll.eq.0) then
         auth_asym_id = ' '
       else
         auth_asym_id = tmparg(1:ll)
       endif
C
C      Get sequence number and insertion code.  If the result
C      is numeric, then we treat insertion code as blank
C      As of version 0.8.0 of mmCIF, we need to check for
C      and author variant, first
C
       result_label_seq_id  = pdbstr(curcat,'auth_seq_id',5,
     *   label_seq_id)
       if(.not.result_label_seq_id.or.label_seq_id.eq.'     ')
     * result_label_seq_id  = pdbstr(curcat,'label_seq_id',5,
     *   label_seq_id)
       call ctonum
       ll=nblen(label_seq_id)
       tmparg(1:max(1,ll))=label_seq_id(1:max(1,ll))
       if(type_.eq.'numb') then
         if(ll.lt.4) then
           label_seq_id = blanks(1:4-ll)//tmparg(1:ll)//' '
         else
           label_seq_id = tmparg(1:ll)//' '
         endif
       else
         if(ll.lt.5) then
           label_seq_id = blanks(1:5-ll)//tmparg(1:ll)
         endif
       endif
       if (.not.fcoord) then
       result_cartn_x = pdbreal(curcat,'cartn_x',8,xstr,cartn_x)
       result_cartn_y = pdbreal(curcat,'cartn_y',8,ystr,cartn_y)
       result_cartn_z = pdbreal(curcat,'cartn_z',8,zstr,cartn_z)
       fcoord = .not.(result_cartn_x.and.result_cartn_y
     *   .and.result_cartn_z)
       endif
       if (fcoord) then
       result_fract_x = pdbreal(curcat,'fract_x',8,xstr,fract_xyz(1))
       result_fract_y = pdbreal(curcat,'fract_y',8,ystr,fract_xyz(2))
       result_fract_z = pdbreal(curcat,'fract_z',8,zstr,fract_xyz(3))
       fcoord = (result_fract_x.and.result_fract_y
     *   .and.result_fract_z)
       endif
       if (fcoord) then
         cartn_x = 0.
         cartn_y = 0.
         cartn_z = 0.
         do jj = 1,3
           cartn_x = cartn_x + matf2o(1,jj)*fract_xyz(jj)
           cartn_y = cartn_y + matf2o(2,jj)*fract_xyz(jj)
           cartn_z = cartn_z + matf2o(3,jj)*fract_xyz(jj)
         enddo
         cartn_x = cartn_x + vecf2o(1)
         cartn_y = cartn_y + vecf2o(2)
         cartn_z = cartn_z + vecf2o(3)
       endif
       result_occupancy = pdbreal(curcat,'occupancy',6,occstr,
     *   occupancy)
       result_B_iso_or_equiv = pdbreal(curcat,'B_iso_or_equiv',6,
     *   Bstr,B_iso_or_equiv)
       if (.not.result_B_iso_or_equiv) then
       result_B_iso_or_equiv = pdbreal(curcat,'U_iso_or_equiv',6,
     *   Bstr,B_iso_or_equiv)
       B_iso_or_equiv = B_iso_or_equiv*8.*pi**2
       endif
       result_footnote_id = pdbint(curcat,'footnote_id',3,
     *   fidstr,footnote_id)
       if(fidstr.ne.' ' .and. (.not.result_footnote_id))
     *   call c2pwarn(' Non-numeric _atom_site.footnote_id '//
     *   fidstr)
       do ii = 1,6
         aniso(ii)=0.
         anisd(ii)=0.
       enddo
       doanisou = .false.
       dosiguij = .false.
       result_aniso_U(1) = pdbreal(curcat,'aniso_U[1][1]',12,
     *   anistr(1),aniso(1))
       result_aniso_U(2) = pdbreal(curcat,'aniso_U[2][2]',12,
     *   anistr(2),aniso(2))
       result_aniso_U(3) = pdbreal(curcat,'aniso_U[3][3]',12,
     *   anistr(3),aniso(3))
       result_aniso_U(4) = pdbreal(curcat,'aniso_U[1][2]',12,
     *   anistr(4),aniso(4))
       result_aniso_U(5) = pdbreal(curcat,'aniso_U[1][3]',12,
     *   anistr(5),aniso(5))
       result_aniso_U(6) = pdbreal(curcat,'aniso_U[2][3]',12,
     *   anistr(6),aniso(6))
       result_aniso_Usd(1) = pdbreal(curcat,'aniso_U[1][1]_esd',12,
     *   anisdstr(1),anisd(1))
       result_aniso_Usd(2) = pdbreal(curcat,'aniso_U[2][2]_esd',12,
     *   anisdstr(2),anisd(2))
       result_aniso_Usd(3) = pdbreal(curcat,'aniso_U[3][3]_esd',12,
     *   anisdstr(3),anisd(3))
       result_aniso_Usd(4) = pdbreal(curcat,'aniso_U[1][2]_esd',12,
     *   anisdstr(4),anisd(4))
       result_aniso_Usd(5) = pdbreal(curcat,'aniso_U[1][3]_esd',12,
     *   anisdstr(5),anisd(5))
       result_aniso_Usd(6) = pdbreal(curcat,'aniso_U[2][3]_esd',12,
     *   anisdstr(6),anisd(6))
       do ii = 1, 6
         if (result_aniso_U(ii) .and. aniso(ii).ne.0.) 
     *     doanisou = .true.
         if (result_aniso_Usd(ii) .and. anisd(ii).ne.0.) 
     *     dosiguij = .true.
       enddo
       if (.not.doanisou .and. .not.dosiguij) then
       result_aniso_U(1) = pdbreal(curcat,'aniso_B[1][1]',12,
     *   anistr(1),aniso(1))
       result_aniso_U(2) = pdbreal(curcat,'aniso_B[2][2]',12,
     *   anistr(2),aniso(2))
       result_aniso_U(3) = pdbreal(curcat,'aniso_B[3][3]',12,
     *   anistr(3),aniso(3))
       result_aniso_U(4) = pdbreal(curcat,'aniso_B[1][2]',12,
     *   anistr(4),aniso(4))
       result_aniso_U(5) = pdbreal(curcat,'aniso_B[1][3]',12,
     *   anistr(5),aniso(5))
       result_aniso_U(6) = pdbreal(curcat,'aniso_B[2][3]',12,
     *   anistr(6),aniso(6))
       result_aniso_Usd(1) = pdbreal(curcat,'aniso_B[1][1]_esd',12,
     *   anisdstr(1),anisd(1))
       result_aniso_Usd(2) = pdbreal(curcat,'aniso_B[2][2]_esd',12,
     *   anisdstr(2),anisd(2))
       result_aniso_Usd(3) = pdbreal(curcat,'aniso_B[3][3]_esd',12,
     *   anisdstr(3),anisd(3))
       result_aniso_Usd(4) = pdbreal(curcat,'aniso_B[1][2]_esd',12,
     *   anisdstr(4),anisd(4))
       result_aniso_Usd(5) = pdbreal(curcat,'aniso_B[1][3]_esd',12,
     *   anisdstr(5),anisd(5))
       result_aniso_Usd(6) = pdbreal(curcat,'aniso_B[2][3]_esd',12,
     *   anisdstr(6),anisd(6))
       do ii = 1, 6
         aniso(ii) = aniso(ii)/(8.*pi**2)
         anisd(ii) = anisd(ii)/(8.*pi**2)
         if (result_aniso_U(ii) .and. aniso(ii).ne.0.) 
     *     doanisou = .true.
         if (result_aniso_Usd(ii) .and. anisd(ii).ne.0.) 
     *     dosiguij = .true.
       enddo

       endif
 140   result_type_symbol = pdbstr(curcat,'type_symbol',4,
     *  type_symbol)
C
C     Set up MODEL/ENDMDL brackets for NMR entries
C
       result_label_model_id = pdbint(curcat,'label_model_id',4,
     *   modstr,modnum)
       if (modstr .eq. '    ') modnum = -9999
       if (pmodnum .ne. modnum) then
         if (pmodnum.ne.-9999) write(iunpdb,'(6HENDMDL)')
         pmodnum = modnum
         if (modnum.ne.-9999) 
     *     write(iunpdb,'(5hMODEL,5x,i4)') modnum
       endif
         
C
C     Fix up the atom name, if it begins with the atom type
C
      lat = nblen(type_symbol)
      lcharge = 0
C
C     The type_symbol may have more structure than simply
C     an element symbol.  There may be very general types,
C     by the most likely are element symbol followed by
C     a charge
C
      if (lat.gt.1) then
        if(type_symbol(lat:lat).eq."+" .or.
     *    type_symbol(lat:lat).eq."-") then
          if (index("0123456789",type_symbol(lat-1:lat-1))
     *      .gt.0) then
            lcharge = 2
            lat = lat-2
          else
            lcharge = 1
            lat = lat-1
          endif
        endif
      endif
C
      if (label_atom_id.eq.' ') label_atom_id = oidstr 
      laid = nblen(label_atom_id)
      tmparg = label_atom_id(1:max(1,laid))
      ic = ichar(label_atom_id(1:1)) - ichar('0')
      if ( ic.lt.0 .or. ic.gt.9) then
        if(laid.gt.0.and.laid.lt.4.and.lat.gt.0) then
          if(label_atom_id(1:lat).eq.type_symbol(1:lat)
     *      .and. lat.eq.1) then
            label_atom_id = ' '//tmparg(1:max(1,laid))
          endif
        else
          if(laid.gt.0.and.laid.lt.4) then
            label_atom_id = ' '//tmparg(1:max(1,laid))
          endif
        endif
      endif
      tmparg = type_symbol(1:max(1,lat))
      if (lat.eq.1) type_symbol = " "//tmparg(1:1)
C
C     Fix up group_PDB
C
      if(.not.result_group_PDB.or.group_PDB .eq. " ") then
        group_PDB = 'ATOM'
        do ii = 1,numhetl
        if (label_comp_id.eq.hetl(ii)) group_PDB = 'HETATM'
        enddo
      else
      if (group_PDB(1:1).eq.'A' .or. group_PDB(1:1).eq.'a')
     *  group_PDB = 'ATOM'
      if (group_PDB(1:1).eq.'H' .or. group_PDB(1:1).eq.'h')
     *  group_PDB = 'HETATM'
      if (group_PDB(1:1).eq.'T' .or. group_PDB(1:1).eq.'t')
     *  group_PDB = 'TER'
      endif
      if (group_PDB(1:1).eq.'A' .or.group_PDB(1:1).eq.'H')
     *  numCoord = numCoord+1
      if (group_PDB(1:1).eq.'T') numTer = numTer+1
      call rjust(label_comp_id)
      call rjust(fidstr)
        write(iunpdb,
     * '(a6,a5,1x,a4,a1,a3,1x,a1,a5,3x,3f8.3,2f6.2,1x,a3,2x,2a4)')
     * group_PDB,idstr,label_atom_id,label_alt_id,label_comp_id,
     * label_asym_id,label_seq_id,cartn_x,cartn_y,cartn_z,
     * occupancy,B_iso_or_equiv,fidstr,auth_asym_id,
     * type_symbol
       if (doanisou) then
         do ii = 1,6
           if (aniso(ii).gt.0.) then
             ianiso(ii) = aniso(ii)*1.e4+.5
           else
            ianiso(ii) = aniso(ii)*1.e4-.5
           endif
         enddo
         write(iunpdb,
     * '(a6,a5,1x,a4,a1,a3,1x,a1,a5,1x,6I7,2x,2a4)')
     * 'ANISOU',idstr,label_atom_id,label_alt_id,label_comp_id,
     * label_asym_id,label_seq_id,ianiso,auth_asym_id,
     * type_symbol
       endif      
       if (dosiguij) then
         do ii = 1,6
           if (anisd(ii).gt.0.) then
             ianisd(ii) = anisd(ii)*1.e4+.5
           else
             ianisd(ii) = anisd(ii)*1.e4-.5
           endif
         enddo
         write(iunpdb,
     * '(a6,a5,1x,a4,a1,a3,1x,a1,a5,1x,6I7,2x,2a4)')
     * 'SIGUIJ',idstr,label_atom_id,label_alt_id,label_comp_id,
     * label_asym_id,label_seq_id,ianisd,auth_asym_id,
     * type_symbol
       endif      
       if (loop_) go to 100
       return
       end
       subroutine proc_author
C
C      process AUTHOR
C
       include 'cif2pdb.cmn'
       logical result_author
       character*80 autstr,nautstr,xtemp,tail
       character*60 author,blanks
       data blanks/
     *   '                                                            '/
       pdbrec = 'AUTHOR'
       icont = 0
       ipos = 1
       iepos = 60
       ltail = 0
       autstr = ' '
       text_ = .false.
       result_author= pdbstr('audit_author',
     * 'name',80,nautstr)
       if(.not.result_author) return
 100   continue
       autstr=nautstr
 110   if(loop_.or.text_) then
         result_author= pdbstr('audit_author',
     *   'name',80,nautstr)
       else
         nautstr = ' '
         result_author=.false.
       endif
       if (result_author .and. nautstr.eq. ' ') go to 110
       lw = nblen(autstr)
       ii = index(autstr(1:lw),',')
       if (ii.ne.0) then
         autstr(ii:ii) = ' '
         if(ii.gt.1.and.ii.lt.lw) then
           if(autstr(lw:lw).eq.'.') then
             xtemp=autstr(ii+1:lw)//autstr(1:ii-1)
             lw=lw-1
           else
             xtemp=autstr(ii+1:lw)//' '//autstr(1:ii-1)
           endif
           autstr=xtemp(1:lw)//char(0)
         endif
       endif
       if (type_code.eq.'u') autstr = upcase(autstr)
       call splitstr(nword,autstr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       if(nword.gt.0.and.nautstr.ne.' ' .and. .not.text_) then
         lw = nblen(cstr(nword))
         cstr(nword)=cstr(nword)(1:lw)//','//char(0)
       endif
       do ii = 2,nword
         xtemp=cstr(1)(1:nblen(cstr(1)))//' '//
     *     cstr(ii)(1:nblen(cstr(ii)))
         cstr(1)=xtemp
       enddo
       nword = 1
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           author(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if((ipos.eq.1.and.icont.eq.0)
     *       .or.(ipos.eq.2.and.icont.gt.0)) then
             author(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if (ltail.gt.0.and.ipos+lw-1.lt.iepos) then
           author(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if (ipos.gt.iepos.or.ltail.gt.0) then               
           pdbline = pdbline+1
           if (icont.eq.0)
     *       write(iunpdb,
     *       '(a6,4x,a)')
     *       pdbrec,author(1:iepos)
           if (icont.gt.0)
     *       write(iunpdb,
     *       '(a6,2x,i2,a)')
     *       pdbrec,icont,author(1:iepos)
           author = ' '
           ipos = 2
           icont = icont+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (nautstr.ne.' ') go to 100
       if ((ipos.gt.1.and.icont.eq.0)
     *   .or.(ipos.gt.2.and.icont.gt.0)) then               
         pdbline = pdbline+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a6,4x,a)')
     *     pdbrec,author(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a6,2x,i2,a)')
     *     pdbrec,icont,author(1:ipos-1)
       endif
       return
       end
       subroutine proc_authrm(recstr,reccat,thisid)
C
C      process AUTHOR's or EDITORS for JRNL or REMARK 1
C
       include 'cif2pdb.cmn'
       character*12 recstr
       character*7 thisid
       character*4 reccat
       character*15 mycat
       logical result_author,result_cid
       character*7 mycid
       character*80 autstr,nautstr,xtemp,tail
       character*51 author,blanks
       data blanks/
     *   '                                                   '/
       icont = 0
       ipos = 1
       iepos = 51
       ltail = 0
       autstr = ' '
       text_ = .false.
       mycat = 'citation_author'
       if (reccat.eq.'EDIT') 
     *   mycat = 'citation_editor'
       result_cid = pdbstr(mycat,
     * 'citation_id',7,mycid)
       if(.not.result_cid) return
       call rjust(mycid)
       if(mycid.ne.thisid) return
       result_author= pdbstr(mycat,
     * 'name',80,nautstr)
       if(.not.result_author) return
 100   continue
       autstr=nautstr
 110   if(loop_.or.text_) then
         result_author= pdbstr(mycat,
     *   'name',80,nautstr)
         result_cid = pdbstr(mycat,
     *   'citation_id',7,mycid)
         if(.not.result_cid) result_author = .false.
         call rjust(mycid)
         if(mycid.ne.thisid) result_author = .false.
         if(.not.result_author) nautstr = ' '
       else
         nautstr = ' '
         result_author=.false.
       endif
       if (result_author .and. nautstr.eq. ' ') go to 110
       lw = nblen(autstr)
       ii = index(autstr(1:lw),',')
       if (ii.ne.0) then
         autstr(ii:ii) = ' '
         if(ii.gt.1.and.ii.lt.lw) then
           if(autstr(lw:lw).eq.'.') then
             xtemp=autstr(ii+1:lw)//autstr(1:ii-1)
             lw=lw-1
           else
             xtemp=autstr(ii+1:lw)//' '//autstr(1:ii-1)
           endif
           autstr=xtemp(1:lw)//char(0)
         endif
       endif
       if (type_code.eq.'u') autstr = upcase(autstr)
       call splitstr(nword,autstr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       if(nword.gt.0.and.nautstr.ne.' ' .and. .not.text_) then
         lw = nblen(cstr(nword))
         cstr(nword)=cstr(nword)(1:lw)//','//char(0)
       endif
       do ii = 2,nword
         xtemp=cstr(1)(1:nblen(cstr(1)))//' '//
     *     cstr(ii)(1:nblen(cstr(ii)))
         cstr(1)=xtemp
       enddo
       nword = 1
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           author(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if(ipos.eq.1) then
             author(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if (ltail.gt.0.and.ipos+lw-1.lt.iepos) then
           author(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if (ipos.gt.iepos.or.ltail.gt.0) then               
           pdbline = pdbline+1
           if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
           if (icont.eq.0)
     *       write(iunpdb,
     *       '(a12,a4,3x,a)')
     *       recstr,reccat,author(1:iepos)
           if (icont.gt.0)
     *       write(iunpdb,
     *       '(a12,a4,i2,1x,a)')
     *       recstr,reccat,icont+1,author(1:iepos)
           author = ' '
           ipos = 1
           icont = icont+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (nautstr.ne.' ') go to 100
       if ((ipos.gt.1.and.icont.eq.0)
     *   .or.(ipos.gt.2.and.icont.gt.0)) then               
         pdbline = pdbline+1
         if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a12,a4,3x,a)')
     *     recstr,reccat,author(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a12,a4,i2,1x,a)')
     *     recstr,reccat,icont+1,author(1:ipos-1)
       endif
       return
       end
       subroutine proc_cryst1
C
C      process cryst1
C
       include 'cif2pdb.cmn'
       character*4 curcat
       logical result_length_a,
     *    result_length_b,
     *    result_length_c,
     *    result_angle_alpha,
     *    result_angle_beta,
     *    result_angle_gamma,
     *    result_Z_PDB,
     *    result_space_group_name
       character*9 axstr,bxstr,cxstr
       character*7 alphastr,betaxstr,gammaxstr
       character*4 Zstr
       character*11 SGstr
       real a,b,c,alpha,beta,gamma
       real*8 cell(6)
       real*8 det
       integer Z
       text_ = .false.

C
C      initialize default cell
C
       cell_a = 1.d0
       cell_b = 1.d0
       cell_c = 1.d0
       cell_alpha = 90.d0
       cell_beta = 90.d0
       cell_gamma = 90.d0
       do ii = 1,3
       vecf2o(ii) = 0.d0
       veco2f(ii) = 0.d0
       do jj = 1,3
         matf2o(ii,jj) = 0.d0
         mato2f(ii,jj) = 0.d0
         if (ii.eq.jj) then
           matf2o(ii,jj) = 1.d0
           mato2f(jj,jj) = 1.d0
         endif
       enddo
       enddo
       a=cell_a
       b=cell_b
       c=cell_b
       alpha=cell_alpha
       beta=cell_beta
       gamma=cell_gamma
C
       result_space_group_name = pdbstr('symmetry',
     * 'space_group_name_H-M',11,SGstr)
       curcat = 'cell'
       pdbrec = 'CRYST1'
       pdbline = pdbline+1
       result_length_a = pdbreal(curcat,'length_a',9,axstr,a)       
       result_length_b = pdbreal(curcat,'length_b',9,bxstr,b)
       result_length_c = pdbreal(curcat,'length_c',9,cxstr,c)
       result_angle_alpha = pdbreal(curcat,'angle_alpha',7,
     *  alphastr,alpha)
       result_angle_beta = pdbreal(curcat,'angle_beta',7,
     *  betaxstr,beta)
       result_angle_gamma = pdbreal(curcat,'angle_gamma',7,
     *  gammaxstr,gamma)
       if (abs(alpha) .lt. 1.) alpha = 90.
       if (abs(beta) .lt. 1.) beta = 90.
       if (abs(gamma) .lt. 1.) gamma = 90.
       result_Z_PDB = pdbint(curcat,'Z_PDB',4,Zstr,Z)
       if (result_length_a) cell_a = a
       if (result_length_b) cell_b = b
       if (result_length_c) cell_c = c
       if (result_angle_alpha) cell_alpha = alpha
       if (result_angle_beta) cell_beta = beta
       if (result_angle_gamma) cell_gamma = gamma
       if (.not.(result_length_a .and. result_length_b .and.
     *   result_length_c .and. result_angle_alpha .and.
     *   result_angle_beta .and. result_angle_gamma)) then
          call c2pwarn(' One or more default cell parameters used ')
       endif
       if (.not.result_space_group_name) then
          SGstr = 'P 1'
          call c2pwarn(' Default space group [P 1] used ')
       endif
       if (.not.result_Z_PDB) then
          Z = 1
          call c2pwarn(' Default Z [1] used ')
       endif          
       write(iunpdb,
     * '(6hCRYST1,3f9.3,3f7.2,1x,a11,i4)')
     *  a,b,c,alpha,beta,gamma,SGstr,Z
       cell(1)=cell_a
       cell(2)=cell_b
       cell(3)=cell_c
       cell(4)=cell_alpha
       cell(5)=cell_beta
       cell(6)=cell_gamma
       call cell2mat(cell,matf2o,mato2f)
       cell_vol = det(matf2o)
       return
       end
       subroutine proc_expdta
C
C      process EXPDTA
C
       include 'cif2pdb.cmn'
       logical result_method,result_details,tryd
       character*80 expstr,nexpstr,tail
       character*60 expwds,blanks
       data blanks/
     *   '                                                            '/
       pdbrec = 'EXPDTA'
       icont = 0
       ipos = 1
       iepos = 60
       ltail = 0
       expstr = ' '
       text_ = .false.
       tryd = .false.
       result_method= pdbstr('exptl',
     * 'method',80,nexpstr)
       result_details=.false.
       if(.not.result_method) return
 100   continue
       expstr=nexpstr
 110   if(text_) then
         if(.not.tryd) then
           result_method = pdbstr('exptl',
     *     'method',80,nexpstr)
         else
           result_details = pdbstr('exptl',
     *     'details',80,nexpstr)
         endif
       else
         if(loop_.or.(.not.tryd)) then
           tryd = .not.tryd
           go to 110
         else
           nexpstr = ' '
           result_method=.false.
           result_details=.false.
         endif
       endif
       if ((result_method .or.result_details)
     *      .and. nexpstr.eq. ' ') go to 110
       if (type_code.eq.'u') expstr = upcase(expstr)
       call splitstr(nword,expstr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       if(nword.gt.0.and.nexpstr.ne.' ' .and. .not.text_) then
         lw = nblen(cstr(nword))
         if(result_method) then
           cstr(nword)=cstr(nword)(1:lw)//','//char(0)
         else
           cstr(nword)=cstr(nword)(1:lw)//';'//char(0)
         endif
       endif
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           expwds(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if((ipos.eq.1.and.icont.eq.0)
     *       .or.(ipos.eq.2.and.icont.gt.0)) then
             expwds(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if (ltail.gt.0.and.ipos+lw-1.lt.iepos) then
           expwds(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if(ipos.le.iepos) then
           expwds(ipos:ipos) = " "
           ipos = ipos+1
         endif
         if (ipos.gt.iepos.or.ltail.gt.0) then               
           pdbline = pdbline+1
           if (icont.eq.0)
     *       write(iunpdb,
     *       '(a6,4x,a)')
     *       pdbrec,expwds(1:iepos)
           if (icont.gt.0)
     *       write(iunpdb,
     *       '(a6,2x,i2,a)')
     *       pdbrec,icont,expwds(1:iepos)
           expwds = ' '
           ipos = 2
           icont = icont+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (nexpstr.ne.' ') go to 100
       if ((ipos.gt.1.and.icont.eq.0)
     *   .or.(ipos.gt.2.and.icont.gt.0)) then               
         pdbline = pdbline+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a6,4x,a)')
     *     pdbrec,expwds(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a6,2x,i2,a)')
     *     pdbrec,icont,expwds(1:ipos-1)
       endif
       return
       end

       subroutine proc_header
C
C      process header
C
       include 'cif2pdb.cmn'
       character*19 curcat
       logical result_details,
     *    result_date,
     *    result_idcode
       character*40 classstr
       character*10 cdate
       character*9 pdate,pdbdate
       character*80 idcode
       pdbrec = 'HEADER'
       pdbline = pdbline+1
       text_ = .false.
       result_details = pdbstr('struct_biol','details',40,classstr)
       if (type_code.eq.'u') classstr = upcase(classstr)
       if (type_code.eq.'p') classstr = upcase(classstr)
       result_date = pdbstr('database_PDB_rev','date_original',
     *  10,cdate)
       if (.not. result_date)
     * result_date = pdbstr('audit','creation_date',
     *  10,cdate)
       pdate = pdbdate(cdate)
       lme = nblen(myentry)
       ito = 0
       if (lme.ne.0) then
         kpmap = nmap
         call hash_store(myentry(1:lme)//char(0),mapstr,mapchain,
     *     NUMSTR,nmap,mhash,NUMHSH,ito)
         if (ito.eq.0)
     *     call c2perr(' More than NUMSTR strings mapped ')
         if (nmap.eq.kpmap+1) mapto(ito) = 0
       endif
       result_idcode = pdbstr('database_2','database_code',80,
     *  idcode)
       if (.not. result_idcode)
     * result_idcode = pdbstr('struct_biol','id',80,
     *  idcode)
       lidc = nblen(idcode)
       if (lidc.gt.0) then
         if (idcode .ne. myentry) then
         call c2pwarn(' Entry id code '//idcode//' does not match '
     *  //'command line -p argument')
         kpmap = nmap
         call hash_store
     *     ('Entry:'//idcode(1:lidc)//char(0),mapstr,mapchain,
     *     NUMSTR,nmap,mhash,NUMHSH,ifrom)
         if (ito.eq.0)
     *     call c2perr(' More than NUMSTR strings mapped ')
         if (ifrom.ne.kpmap+1.and.mapto(ifrom).ne.0) then
  80       call c2perr(' Previous mapping of '//idcode(1:lidc))
         endif
         mapto(ifrom) = ito
         idcode = myentry
         lidc = lme
       endif
       endif
       if (lidc.eq.0) then
         lidc = 1
         idcode(1:1) = ' '
       endif
       write(iunpdb,
     * '(6hHEADER,4x,a40,a9,3x,a4)') classstr,pdate,idcode(1:lidc)
       return
       end
       subroutine proc_keywds
C
C      process KEYWDS
C
       include 'cif2pdb.cmn'
       logical result_keywds
       character*80 keystr,nkeystr,tail
       character*60 keywds,blanks
       data blanks/
     *   '                                                            '/
       pdbrec = 'KEYWDS'
       icont = 0
       ipos = 1
       iepos = 60
       ltail = 0
       keystr = ' '
       text_ = .false.
       result_keywds= pdbstr('struct_keywords',
     * 'text',80,nkeystr)
       if(.not.result_keywds) return
 100   continue
       keystr=nkeystr
 110   if(loop_.or.text_) then
         result_keywds= pdbstr('struct_keywords',
     *   'text',80,nkeystr)
       else
         nkeystr = ' '
         result_keywds=.false.
       endif
       if (result_keywds .and. nkeystr.eq. ' ') go to 110
       if (type_code.eq.'u') keystr = upcase(keystr)
       call splitstr(nword,keystr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       if(nword.gt.0.and.nkeystr.ne.' ' .and. .not.text_) then
         lw = nblen(cstr(nword))
         cstr(nword)=cstr(nword)(1:lw)//','//char(0)
       endif
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           keywds(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if((ipos.eq.1.and.icont.eq.0)
     *       .or.(ipos.eq.2.and.icont.gt.0)) then
             keywds(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if (ltail.gt.0.and.ipos+lw-1.lt.iepos) then
           keywds(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if(ipos.le.iepos) then
           keywds(ipos:ipos) = " "
           ipos = ipos+1
         endif
         if (ipos.gt.iepos.or.ltail.gt.0) then               
           pdbline = pdbline+1
           if (icont.eq.0)
     *       write(iunpdb,
     *       '(a6,4x,a)')
     *       pdbrec,keywds(1:iepos)
           if (icont.gt.0)
     *       write(iunpdb,
     *       '(a6,2x,i2,a)')
     *       pdbrec,icont,keywds(1:iepos)
           keywds = ' '
           ipos = 2
           icont = icont+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (nkeystr.ne.' ') go to 100
       if ((ipos.gt.1.and.icont.eq.0)
     *   .or.(ipos.gt.2.and.icont.gt.0)) then               
         pdbline = pdbline+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a6,4x,a)')
     *     pdbrec,keywds(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a6,2x,i2,a)')
     *     pdbrec,icont,keywds(1:ipos-1)
       endif
       return
       end

       subroutine proc_master
C
C      process master and end
C
       include 'cif2pdb.cmn'
       pdbrec = 'MASTER'
       pdbline = pdbline+1
       write(iunpdb,
     * '(6hMASTER,4x,12I5)')
     * numRemark,numFtnote,numHet,numHelix,numSheet,numTurn,
     * numSite,numXform,numCoord,numTer,numConect,numSeq
       pdbrec = 'END'
       pdbline = pdbline+1
       write(iunpdb,'(3hEND)')
       call c2pmsg(' ',' Processing Finished')
       return
       end
       subroutine proc_origx
C
C      process origx
C
       include 'cif2pdb.cmn'
       character*19 curcat
       logical result_origx11,
     *    result_origx12,
     *    result_origx13,
     *    result_origx21,
     *    result_origx22,
     *    result_origx23,
     *    result_origx31,
     *    result_origx32,
     *    result_origx33,
     *    result_origxv1,
     *    result_origxv2,
     *    result_origxv3
       character*10 x11str,x12str,x13str,x21str,x22str,x23str,
     *    x31str,x32str,x33str,v1str,v2str,v3str
       real x11,x12,x13,x21,x22,x23,x31,x32,x33,v1,v2,v3
       real*8 new_vol
       curcat = 'database_pdb_matrix'
       pdbrec = 'ORIGX'
       pdbline = pdbline+1
       result_origx11 = pdbreal(curcat,'origx[1][1]',10,x11str,x11)
       result_origx12 = pdbreal(curcat,'origx[1][2]',10,x12str,x12)
       result_origx13 = pdbreal(curcat,'origx[1][3]',10,x13str,x13)
       result_origxv1 = pdbreal(curcat,'origx_vector[1]',10,
     *   v1str,v1)
       pdbline = pdbline+1
       result_origx21 = pdbreal(curcat,'origx[2][1]',10,x21str,x21)
       result_origx22 = pdbreal(curcat,'origx[2][2]',10,x22str,x22)
       result_origx23 = pdbreal(curcat,'origx[2][3]',10,x23str,x23)
       result_origxv2 = pdbreal(curcat,'origx_vector[2]',10,
     *   v2str,v2)
       pdbline = pdbline+1
       result_origx31 = pdbreal(curcat,'origx[3][1]',10,x31str,x31)
       result_origx32 = pdbreal(curcat,'origx[3][2]',10,x32str,x32)
       result_origx33 = pdbreal(curcat,'origx[3][3]',10,x33str,x33)
       result_origxv3 = pdbreal(curcat,'origx_vector[3]',10,
     *   v3str,v3)
       if(result_origx11) write(iunpdb,
     * '(5hORIGX,i1,4x,3f10.6,5x,f10.5)') 1,x11,x12,x13,v1,
     *  2,x21,x22,x23,v2,3,x31,x32,x33,v3
       if(result_origx11) numXform = numXform+3
       if(.not.result_origx11) pdbline = pdbline-3
       return
       end
       subroutine proc_scale
C
C      process scale
C
       include 'cif2pdb.cmn'
       character*10 curcat
       logical result_scale11,
     *    result_scale12,
     *    result_scale13,
     *    result_scale21,
     *    result_scale22,
     *    result_scale23,
     *    result_scale31,
     *    result_scale32,
     *    result_scale33,
     *    result_scalev1,
     *    result_scalev2,
     *    result_scalev3
       character*10 x11str,x12str,x13str,x21str,x22str,x23str,
     *    x31str,x32str,x33str,v1str,v2str,v3str
       real x11,x12,x13,x21,x22,x23,x31,x32,x33,v1,v2,v3
       character*12 fts
       fts = 'fract_transf'
       curcat = 'atom_sites'
       pdbrec = 'SCALE'
       pdbline = pdbline+1
       result_scale11 = pdbreal(curcat,fts//'_matrix[1][1]',
     *   10,x11str,x11)
       result_scale12 = pdbreal(curcat,fts//'_matrix[1][2]',
     *   10,x12str,x12)
       result_scale13 = pdbreal(curcat,fts//'_matrix[1][3]',
     *   10,x13str,x13)
       result_scalev1 = pdbreal(curcat,fts//'_vector[1]',10,
     *   v1str,v1)
       pdbline = pdbline+1
       result_scale21 = pdbreal(curcat,fts//'_matrix[2][1]',
     *   10,x21str,x21)
       result_scale22 = pdbreal(curcat,fts//'_matrix[2][2]',
     *   10,x22str,x22)
       result_scale23 = pdbreal(curcat,fts//'_matrix[2][3]',
     *   10,x23str,x23)
       result_scalev2 = pdbreal(curcat,fts//'_vector[2]',10,
     *   v2str,v2)
       pdbline = pdbline+1
       result_scale31 = pdbreal(curcat,fts//'_matrix[3][1]',
     *   10,x31str,x31)
       result_scale32 = pdbreal(curcat,fts//'_matrix[3][2]',
     *   10,x32str,x32)
       result_scale33 = pdbreal(curcat,fts//'_matrix[3][3]',
     *   10,x33str,x33)
       result_scalev3 = pdbreal(curcat,fts//'_vector[3]',10,
     *   v3str,v3)
       if (.not.(result_scale11.and.result_scale12.and.result_scale13
     *    .and.result_scale21.and.result_scale22.and.result_scale23
     *    .and.result_scale31.and.result_scale32.and.result_scale33
     *    .and.result_scalev1.and.result_scalev2.and.result_scalev3))
     *    then
       x11 = mato2f(1,1)
       x12 = mato2f(1,2)
       x13 = mato2f(1,3)
       x21 = mato2f(2,1)
       x22 = mato2f(2,2)
       x23 = mato2f(2,3)
       x31 = mato2f(3,1)
       x32 = mato2f(3,2)
       x33 = mato2f(3,3)
       v1 = veco2f(1)
       v2 = veco2f(2)
       v3 = veco2f(3)
       call c2pwarn(' Default SCALE used ')
       else
       mato2f(1,1) = x11
       mato2f(1,2) = x12
       mato2f(1,3) = x13
       mato2f(2,1) = x12
       mato2f(2,2) = x22
       mato2f(2,3) = x23
       mato2f(3,1) = x31
       mato2f(3,2) = x32
       mato2f(3,3) = x33
       veco2f(1) = v1
       veco2f(2) = v2
       veco2f(3) = v3
       endif
       call invxfrm(mato2f,veco2f,matf2o,vecf2o)
       write(iunpdb,
     * '(5hSCALE,i1,4x,3f10.6,5x,f10.5)') 1,x11,x12,x13,v1,
     *  2,x21,x22,x23,v2,3,x31,x32,x33,v3
       numXform = numXform+3
       return
       end
       subroutine proc_remark
C
C      process REMARK and JRNL
C
       include 'cif2pdb.cmn'
       logical bkmrk_
       logical result_remark,result_remid
       logical result_cid, result_bmk, have_primary
       dimension iremno(999)
       parameter (MARKS=50)
       character*7 citjl(MARKS),cital(MARKS),citel(MARKS)
       character*7 ctemp
       integer markjl(MARKS),markal(MARKS),markel(MARKS)
       integer markjl2(MARKS)
       integer nordjl(MARKS),nordal(MARKS),nordel(MARKS)
       integer kremno,ii,iii,kk,jj
       character*4 remids
       character*7 cidstr
       character*80 remstr,tail
       character*59 remark,blanks
       data iremno /999*0/
       data blanks/
     *   '                                                           '/
       pdbrec = 'JRNL'
       ncid = 0
       ncidal = 0
       ncidel = 0
       have_primary = .false.
  10   result_cid = pdbstr('citation','id',7,cidstr)
       if (.not.result_cid) go to 20
       if (cidstr.eq.'primary') have_primary = .true.
       call rjust(cidstr)
       if (ncid.eq.0) then
         citjl(1) = cidstr
         markjl(1) = 0
         result_bmk = bkmrk_(markjl(1))
         markjl2(1) = 0
         result_bmk = bkmrk_(markjl2(1))
         ncid = 1
       else
         if (citjl(ncid).ne.cidstr) then
           ncid = ncid+1
           if (ncid.gt.MARKS) 
     *       call c2perr(' Overflow of citjl array, increase MARKS')
           citjl(ncid) = cidstr
           markjl(ncid) = 0
           markjl2(ncid) = 0
           result_bmk = bkmrk_(markjl(ncid))
           result_bmk = bkmrk_(markjl2(ncid))
         endif
       endif
       if (loop_) go to 10
       call ssort(citjl,ncid,7,nordjl)
  20   result_cid = pdbstr('citation_author','citation_id',7,cidstr)
       if(.not.result_cid) go to 30
       call rjust(cidstr)
       if (cidstr.eq.'primary') have_primary = .true.
       if (ncidal.eq.0) then
         cital(1) = cidstr
         markal(1) = 0
         result_bmk = bkmrk_(markal(1))
         ncidal = 1
       else
         if (cital(ncidal).ne.cidstr) then
           ncidal = ncidal+1
           if (ncidal.gt.MARKS) 
     *       call c2perr(' Overflow of cital array, increase MARKS')
           cital(ncidal) = cidstr
           markal(ncidal) = 0
           result_bmk = bkmrk_(markal(ncidal))
         endif
       endif
       if (loop_) go to 20
       call ssort(cital,ncidal,7,nordal)
  30   result_cid = pdbstr('citation_editor','citation_id',7,cidstr)
       if(.not.result_cid) go to 40
       if (cidstr.eq.'primary') have_primary = .true.
       call rjust(cidstr)
       if (ncidel.eq.0) then
         citel(1) = cidstr
         markel(1) = 0
         result_bmk = bkmrk_(markel(1))
         ncidel = 1
       else
         if (citel(ncidel).ne.cidstr) then
           ncidel = ncidel+1
           if (ncidel.gt.MARKS) 
     *       call c2perr(' Overflow of citel array, increase MARKS')
           citel(ncidel) = cidstr
           markel(ncidel) = 0
           result_bmk = bkmrk_(markel(ncidel))
         endif
       endif
       if (loop_) go to 30
       call ssort(citel,ncidel,7,nordel)
  40   continue
       if (have_primary) then
         do ii = 1,ncidal
         if (cital(ii).eq.'primary') then
           result_bmk = bkmrk_(markal(ii))
           call proc_authrm('JRNL        ','AUTH',cital(ii))
         endif
         enddo
         do ii = 1,ncid
         if (citjl(ii).eq.'primary') then
           result_bmk = bkmrk_(markjl(ii))
           call proc_titlrm('JRNL        ','TITL',citjl(ii))
         endif
         enddo
         do ii = 1,ncidel
         if (citel(ii).eq.'primary') then
           result_bmk = bkmrk_(markel(ii))
           call proc_authrm('JRNL        ','EDIT',citel(ii))
         endif
         enddo
         do ii = 1,ncid
         if (citjl(ii).eq.'primary') then
           result_bmk = bkmrk_(markjl2(ii))
           call proc_refrm('JRNL        ','REF ',citjl(ii))
         endif
         enddo
       endif
       pdbrec = 'REMARK'
       do iii = 1,ncid
         kk = nordjl(iii)
         if (citjl(kk).ne.'primary') then
         pdbline = pdbline+1
         numRemark = numRemark+1
         cidstr = citjl(kk)
         call ljust(cidstr)
         write(iunpdb,'(a)') 'REMARK   1 REFERENCE '//cidstr
         do ii = 1,ncidal
         jj = nordal(ii)
         if (cital(jj).eq.citjl(kk)) then
           result_bmk = bkmrk_(markal(jj))
           call proc_authrm('REMARK   1  ','AUTH',cital(jj))
         endif
         enddo
         result_bmk = bkmrk_(markjl(kk))
         call proc_titlrm('REMARK   1  ','TITL',citjl(kk))
         do ii = 1,ncidel
         jj = nordel(ii)
         if (citel(jj).eq.citjl(kk)) then
           result_bmk = bkmrk_(markel(jj))
           call proc_authrm('REMARK   1  ','EDIT',citel(jj))
         endif
         enddo
         result_bmk = bkmrk_(markjl2(kk))
         call proc_refrm('REMARK   1  ','REF ',citjl(kk))
         endif
       enddo
       icrem = -9999
       ipos = 1
       iepos = 59
       ltail = 0
       indent = 0
       mode = 1
       text_ = .false.
  90   result_remid = pdbstr('database_PDB_remark','id',4,remids)
       if(.not.result_remid) goto 400
       call rjust(remids)
       read(remids,'(i4)',err=95) kremno
       if(kremno.ge.1.and.kremno.le.999) iremno(kremno)=1
  95   ifirst = 1
 100   continue
       result_remark= pdbstr('database_PDB_remark',
     * 'text',80,remstr)
       if (remstr(1:2).eq.'  ') indent = 1
       lwr = nblen(remstr)
       if (type_code.eq.'u') remstr = upcase(remstr)
       if (remstr(1:1).eq.' ' .and.
     *   lwr.gt.1 .and.
     *   lwr-1+ipos.le.iepos+1 .and.
     *   ipos .eq. 1) then
         indent = 1
         nword = 1
         cstr(1) = remstr(2:lwr)//char(0)
       else
         if (remstr(1:6).eq.'REMARK') then
           indent = 1
           nword = 1
           cstr(1) = remstr(12:70)//char(0)
         else
           call splitstr(nword,remstr,cstr,128,' ')
         endif
       endif
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           remark(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if((ipos.eq.1.and.icont.eq.0)
     *       .or.(ipos.eq.2.and.icont.gt.0)) then
             remark(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if ((ltail.gt.0.and.ipos+lw-1.lt.iepos) .or.
     *     (indent.eq.1.and.ii.eq.nword)) then
           remark(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if(ipos.le.iepos) then
           remark(ipos:ipos) = " "
           ipos = ipos+1
         endif
         if ((ipos.gt.iepos.or.ltail.gt.0) .or.
     *     (indent.eq.1.and.ii.eq.nword)) then
           if(ifirst.eq.1) then
             ifirst = ifirst+1
             if(remark(1:iepos).ne.' ') then
               pdbline = pdbline+1
               write(iunpdb,'(a6,a4)') pdbrec,remids
             endif
           endif               
           pdbline = pdbline+1
           write(iunpdb,
     *       '(a6,a4,1x,a)')
     *       pdbrec,remids,remark(1:iepos)
           remark = ' '
           ipos = 1
           numRemark = numRemark+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (text_) go to 100
       if (ipos.gt.1) then
         if(ifirst.eq.1) then
           ifirst = ifirst+1
           if(remark(1:ipos-1).ne.' ') then
             pdbline = pdbline+1
             write(iunpdb,'(a6,a4)') pdbrec,remids
           endif
         endif               
         write(iunpdb,
     *       '(a6,a4,1x,a)')
     *       pdbrec,remids,remark(1:ipos-1)
         pdbline = pdbline+1
         numRemark = numRemark+1
         ipos = 1
         remark = ' '
       endif
       if (loop_) go to 90
 400   do ii = 960,950,-1
       if (iremno(ii).eq.0) go to 410
       enddo
       ii=96
       call c2pwarn(' REMARK 950-960 already used ')
 410   call tagchk(ii,iunpdb)
       return
       end
       subroutine proc_titlrm(recstr,reccat,thisid)
C
C      process TITLE for JRNL or REMARK 1
C
       include 'cif2pdb.cmn'
       character*12 recstr
       character*7 thisid
       character*4 reccat
       character*8 mycat
       logical result_title,result_cid
       character*7 mycid
       character*80 titstr,ntitstr,xtemp,tail
       character*51 title,blanks
       data blanks/
     *   '                                                   '/
       icont = 0
       ipos = 1
       iepos = 51
       ltail = 0
       titstr = ' '
       title = ' '
       text_ = .false.
       mycat = 'citation'
       result_title= pdbstr(mycat,
     * 'title',80,ntitstr)
       if(.not.result_title) return
 100   continue
       titstr=ntitstr
 110   if(text_) then
         result_title= pdbstr(mycat,
     *   'title',80,ntitstr)
         if(.not.result_title) ntitstr = ' '
       else
         ntitstr = ' '
         result_title=.false.
       endif
       if (result_title .and. ntitstr.eq. ' ') go to 110
       lw = nblen(titstr)
       if (type_code.eq.'u') titstr = upcase(titstr)
       call splitstr(nword,titstr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           title(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if(ipos.eq.1) then
             title(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if (ltail.gt.0.and.ipos+lw-1.lt.iepos) then
           title(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if(ipos.le.iepos) then
           title(ipos:ipos) = " "
           ipos = ipos+1
         endif
         if (ipos.gt.iepos.or.ltail.gt.0) then               
           pdbline = pdbline+1
           if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
           if (icont.eq.0)
     *       write(iunpdb,
     *       '(a12,a4,3x,a)')
     *       recstr,reccat,title(1:iepos)
           if (icont.gt.0)
     *       write(iunpdb,
     *       '(a12,a4,i2,1x,a)')
     *       recstr,reccat,icont+1,title(1:iepos)
           title = ' '
           ipos = 1
           icont = icont+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (ntitstr.ne.' ') go to 100
       if (ipos.gt.1) then               
         pdbline = pdbline+1
         if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a12,a4,3x,a)')
     *     recstr,reccat,title(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a12,a4,i2,1x,a)')
     *     recstr,reccat,icont+1,title(1:ipos-1)
       endif
       return
       end
       subroutine proc_refrm(recstr,reccat,thisid)
C
C      process REF, PUBL and REFN for JRNL or REMARK 1
C
       include 'cif2pdb.cmn'
       character*12 recstr
       character*7 thisid
       character*4 reccat
       character*8 mycat
       logical result_title,result_cid
       logical result_vol, result_page, result_abbrev
       logical result_year, result_publ, result_ASTM
       logical result_country, result_ISSN, result_ISBN
       logical result_CSD, book_title
       character volstr*4,pagestr*5,abbrevstr*80,
     *   yearstr*4,publstr*80,ASTMstr*6,countrystr*2,
     *   ISSNstr*25,ISBNstr*25,CSDstr*4
       character*7 mycid
       character*80 titstr,ntitstr,xtemp,tail
       character*2 xvstr
       character*4 xISxNstr
       character*4 xASTMstr
       character*51 title,blanks
       data blanks/
     *   '                                                   '/
       mycat='citation'
       result_vol=pdbstr(mycat,'journal_volume',4,volstr)
       result_page=pdbstr(mycat,'page_first',5,pagestr)
       result_year=pdbstr(mycat,'year',4,yearstr)
       result_country=pdbstr(mycat,'country',2,countrystr)
       result_ASTM=pdbstr(mycat,'journal_id_ASTM',
     *   6,ASTMstr)
       if (.not.result_ASTM)
     * result_ASTM=pdbstr(mycat,'journal_coden_ASTM',
     *   6,ASTMstr)
       result_ISSN=pdbstr(mycat,'journal_id_ISSN',
     *   25,ISSNstr)
       if (.not.result_ISSN)
     * result_ISSN=pdbstr(mycat,'journal_coden_ISSN',
     *   25,ISSNstr)
       result_ISBN=pdbstr(mycat,'book_id_ISBN',
     *   25,ISBNstr)
       if (.not.result_ISBN)
     *  result_ISBN=pdbstr(mycat,'book_coden_ISBN',
     *   25,ISBNstr)
       result_CSD=pdbstr(mycat,'journal_id_CSD',
     *   4,CSDstr)
       if (.not.result_CSD)
     *  result_CSD=pdbstr(mycat,'journal_coden_CSD',
     *   4,CSDstr)
       xASTMstr='ASTM'
       if(ASTMstr.eq.' ' .or.(.not.result_ASTM))
     *   xASTMstr=' '
       call rjust(volstr)
       xvstr = 'V.'
       if(volstr.eq.' '.or.(.not.result_vol)) xvstr='  '
       xISxNstr = '    '
       if(result_ISSN.and.ISSNstr.ne.' ') then
         xISxNstr = 'ISSN'
       else
         if(result_ISBN.and.ISBNstr.ne.' ') then
           xISxNstr = 'ISBN'
           ISSNstr=ISBNstr
         endif
       endif
       call rjust(pagestr)
       call rjust(yearstr)
       call rjust(CSDstr)
       do ipass = 1,2
       icont = 0
       ipos = 1
       iepos = 51
       if(ipass.eq.1) iepos = 28
       ltail = 0
       titstr = ' '
       text_ = .false.
       mycat = 'citation'
       if(ipass.eq.1) then
         result_title = pdbstr(mycat,
     *   'journal_abbrev',80,ntitstr)
         if(.not.result_title) then
           book_title = pdbstr(mycat,
     *     'book_title',80,ntitstr)
           result_title=book_title
         endif
       else
         result_title = pdbstr(mycat,
     *   'book_publisher',80,ntitstr)
       endif
       if(.not.result_title) goto 900
       title=' '
 100   continue
       titstr=ntitstr
 110   if(text_) then
         if(ipass.eq.1) then
         if (.not.book_title) then
         result_title= pdbstr(mycat,
     *   'journal_abbrev',80,ntitstr)
         else
         result_title= pdbstr(mycat,
     *   'book_title',80,ntitstr)
         endif
         else
         result_title= pdbstr(mycat,
     *   'book_publisher',80,ntitstr)
         endif
         if(.not.result_title) ntitstr = ' '
       else
         ntitstr = ' '
         result_title=.false.
       endif
       if (result_title .and. ntitstr.eq. ' ') go to 110
       lw = nblen(titstr)
       tmparg = titstr(1:max(1,lw))
       if (type_code.eq.'u') titstr = upcase(tmparg(1:max(1,lw)))
       call splitstr(nword,titstr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       do ii = 1,nword
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           title(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if(ipos.eq.1) then
             title(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if (ltail.gt.0.and.ipos+lw-1.lt.iepos) then
           title(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if(ipos.le.iepos) then
           title(ipos:ipos) = " "
           ipos = ipos+1
         endif
         if (ipos.gt.iepos.or.ltail.gt.0) then               
           pdbline = pdbline+1
           if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
           if (icont.eq.0) then
             if(ipass.eq.1) then
               write(iunpdb,
     *           '(a12,a4,3x,a28,2x,a2,a4,1x,a5,1x,a4)')
     *           recstr,'REF ',title(1:iepos),
     *           xvstr,volstr,pagestr,yearstr
             else
               write(iunpdb,'(a12,a4,3x,a)')
     *           recstr,'PUBL',title(1:iepos)
             endif
           else
             if(ipass.eq.1) then
               write(iunpdb,
     *         '(a12,a4,i2,1x,a)')
     *         recstr,'REF ',icont+1,title(1:iepos)
             else
               write(iunpdb,
     *         '(a12,a4,i2,1x,a)')
     *         recstr,'PUBL',icont+1,title(1:iepos)
             endif
           endif
           title = ' '
           ipos = 1
           icont = icont+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (ntitstr.ne.' ') go to 100
       if (ipos.gt.1) then               
         pdbline = pdbline+1
         if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
         if (icont.eq.0) then
           if(ipass.eq.1) then
             write(iunpdb,
     *         '(a12,a4,3x,a28,2x,a2,a4,1x,a5,1x,a4)')
     *         recstr,'REF ',title(1:iepos),
     *         xvstr,volstr,pagestr,yearstr
           else
             write(iunpdb,'(a12,a4,3x,a)')
     *         recstr,'PUBL',title(1:iepos)
           endif
         else
           if(ipass.eq.1) then
             write(iunpdb,
     *       '(a12,a4,i2,1x,a)')
     *       recstr,'REF ',icont+1,title(1:iepos)
           else
             write(iunpdb,
     *       '(a12,a4,i2,1x,a)')
     *       recstr,'PUBL',icont+1,title(1:iepos)
           endif
         endif
       endif
 900   if(ipass.eq.2) then
         pdbline = pdbline+1
         if (recstr(1:4).eq.'REMA') numRemark = numRemark+1
         write(iunpdb,
     *   '(a12,a4,3x,a4,1x,a6,2x,a2,1x,a4,1x,a25,1x,a4)')
     *   recstr,'REFN',xASTMstr,ASTMstr,countrystr,
     *   xISxNstr,ISSNstr,CSDstr
       endif
       enddo
       return
       end
       subroutine proc_seqres
C
C      process SEQRES
C
       include 'cif2pdb.cmn'
       logical result_entity_id
       logical result_num
       logical result_mon_id
       character*3 monidstr
       character*33 entstr,pentstr
       character*7 snumstr,psnumstr
       character*1 curchain
       character*51 resstr(100)
       pdbrec = 'SEQRES'
       ipos = 1
       iser = 1
       numres = 0
       loop_ = .false.
       psnumstr = ' '
       pentstr = ' '
       curchain = ' '
       resstr(1) = ' '
       text_=.false.
 100   result_mon_id = pdbstr('entity_poly_seq','mon_id',
     *  3,monidstr)
       result_entity_id = pdbstr('entity_poly_seq','entity_id',
     *  33,entstr)
       result_num = pdbstr('entity_poly_seq','num',7,snumstr)
       if (result_mon_id .and. result_entity_id .and.
     *   result_num .and. snumstr .ne.psnumstr) then
         if (entstr.ne.pentstr )then
           if (ipos.eq.1) iser = iser-1
           if (numres.gt.0) then
           numhit = 0
           do ii = 1,num_chains
             if (entity_list(ii).eq.pentstr) then
               numhit = numhit+1
               write(iunpdb,'(6HSEQRES,2x,i2,1x,a1,1x,i4,2x,a51)')
     *           (kser,
     *           chain_list(ii),numres,resstr(kser),kser=1,iser)
               numSeq = numSeq+1
             endif
           enddo
           if (numhit.eq.0)
     *       call c2pwarn(' Found no chains for SEQRES entity '//
     *       entstr)
           endif
           pentstr = entstr
           numres = 0
           iser = 1
           ipos = 1
           resstr(1) = ' '
         endif
         psnumstr = snumstr
         if (entstr.eq.pentstr) then
           call rjust(monidstr)
           resstr(iser)(ipos:ipos+3) = monidstr//' '
           numres = numres+1
           ipos = ipos+4
           if (ipos.gt.51) then
             iser = iser+1
             ipos = 1
             if (iser.gt.100) call c2perr(' Too many SEQRES cards')
             resstr(iser) = ' '
           endif
         endif
       endif
       if (loop_) go to 100
       if (ipos.eq.1) iser = iser-1
       if (numres.gt.0) then
         numhit = 0
         do ii = 1,num_chains
           if (entity_list(ii).eq.pentstr) then
             numhit = numhit+1
             write(iunpdb,'(6HSEQRES,2x,i2,1x,a1,1x,i4,2x,a51)')
     *         (kser,
     *         chain_list(ii),numres,resstr(kser),kser=1,iser)
             numSeq = numSeq+1
           endif
         enddo
         if (numhit.eq.0)
     *     call c2pwarn(' Found no chains for SEQRES entity '//
     *     entstr)
       endif
       return
       end
       subroutine proc_title
C
C      process TITLE
C
       include 'cif2pdb.cmn'
       logical result_title,result_cavid
       character*80 titstr,tail
       character*60 title,blanks
       data blanks/
     *   '                                                            '/
       pdbrec = 'TITLE'
       icont = numTitle
       ipos = 1
       iepos = 60
       ltail = 0
       indent = 0
       mode = 1
       text_ = .false.
 100   continue
       if (mode.eq.1) then
       result_title= pdbstr('struct',
     * 'title',80,titstr)
       else
       result_title = pdbstr('database_pdb_caveat',
     * 'text',80,titstr)
       if (titstr(1:6).eq.'CAVEAT' .and.
     *   titstr(12:15).eq.myentry) then
         titstr(1:15) = '               '
       endif
       endif
       if (titstr(1:3).eq.'   ') indent = 1
       if (type_code.eq.'u') titstr = upcase(titstr)
       call splitstr(nword,titstr,cstr,128,' ')
       if (type_code.eq.'p') then
       do ii = 1,nword
         cstr(ii) = typeset(cstr(ii)(1:nblen(cstr(ii)))//" ")
       enddo
       endif
       do ii = 1,nword
       if (cstr(ii).eq.'Compound::'//char(0) .or.
     *   cstr(ii).eq.'Source::'//char(0) .or.
     *   cstr(ii).eq.'COMPOUND::'//char(0) .or.
     *   cstr(ii).eq.'SOURCE::'//char(0) .or.
     *   cstr(ii).eq.'Error::'//char(0) .or.
     *   cstr(ii).eq.'ERROR::'//char(0)) then
       if ((ipos.gt.1.and.icont.eq.0)
     *   .or.(ipos.gt.2.and.icont.gt.0)) then               
         pdbline = pdbline+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a6,4x,a)')
     *     pdbrec,title(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a6,2x,i2,a)')
     *     pdbrec,icont,title(1:ipos-1)
       endif
       if (cstr(ii).eq.'Compound::'//char(0) .or.
     *   cstr(ii).eq.'COMPOUND::'//char(0)) then
         pdbrec = 'COMPND'
         icont = numCompound
       endif
       if (cstr(ii).eq.'Source::'//char(0) .or.
     *   cstr(ii).eq.'SOURCE::'//char(0)) then
         pdbrec = 'SOURCE'
         icont = numSource
       endif
       if (cstr(ii).eq.'Error::'//char(0) .or.
     *   cstr(ii).eq.'ERROR::'//char(0)) then
         pdbrec = 'CAVEAT'
         icont = numCaveat
       endif
       ipos = 1
       if (icont.gt.0) ipos = 2
       if (pdbrec .eq. 'CAVEAT') then
         ipos = 10
         title(1:10) = ' '//myentry
         go to 100
       endif
       go to 300
       endif
 200     lw = nblen(cstr(ii))
         if (lw+ipos.le.iepos+1) then
           title(ipos:lw+ipos-1) = cstr(ii)(1:lw)
         else
           if((ipos.eq.1.and.icont.eq.0)
     *       .or.(ipos.eq.2.and.icont.gt.0)) then
             title(ipos:iepos) = cstr(ii)(1:iepos-ipos+1)
             ltail = lw - (iepos-ipos+1)
             ipos = iepos
             lw = lw-ltail
           else
             tail = cstr(ii)(1:lw)
             ltail = lw
             lw = 0
           endif
         endif
         if ((ltail.gt.0.and.ipos+lw-1.lt.iepos) .or.
     *     (indent.eq.1.and.ii.eq.nword)) then
           title(ipos+lw:iepos) = blanks(1:iepos-(ipos+lw)+1)         
         endif
         ipos = ipos+lw
         if(ipos.le.iepos) then
           title(ipos:ipos) = " "
           ipos = ipos+1
         endif
         if ((ipos.gt.iepos.or.ltail.gt.0) .or.
     *     (indent.eq.1.and.ii.eq.nword)) then               
           pdbline = pdbline+1
           if (icont.eq.0)
     *       write(iunpdb,
     *       '(a6,4x,a)')
     *       pdbrec,title(1:iepos)
           if (icont.gt.0)
     *       write(iunpdb,
     *       '(a6,2x,i2,a)')
     *       pdbrec,icont,title(1:iepos)
           title = ' '
           ipos = 2
           icont = icont+1
           if (pdbrec .eq. 'TITLE') numTitle = numTitle+1
           if (pdbrec .eq. 'COMPND') numCompound = numCompound+1
           if (pdbrec .eq. 'SOURCE') numSource = numSource+1
           if (pdbrec .eq. 'CAVEAT') numCaveat = numCaveat+1
           if (ltail.gt.0) then
             cstr(ii) = tail
             ltail = 0
             go to 200
           endif
         endif
 300   continue
       enddo
       if (text_) go to 100
       if ((pdbrec.ne.'CAVEAT' .and.
     *   ((ipos.gt.1.and.icont.eq.0)
     *   .or.(ipos.gt.2.and.icont.gt.0))) .or.
     *   (pdbrec.eq.'CAVEAT' .and. ipos.gt.10)) then               
         pdbline = pdbline+1
         if (icont.eq.0)
     *     write(iunpdb,
     *     '(a6,4x,a)')
     *     pdbrec,title(1:ipos-1)
         if (icont.gt.0)
     *     write(iunpdb,
     *     '(a6,2x,i2,a)')
     *     pdbrec,icont,title(1:ipos-1)
       endif
       if (mode.eq.2) return
       titstr = ' '
       result_cavid = pdbstr('database_pdb_caveat',
     * 'id',80,titstr)
       if (result_cavid .and. titstr(1:4).ne.'    ') then
         mode = 2
         pdbrec = 'CAVEAT'
         icont = numCaveat
         ipos = 10
         title(1:10) = ' '//myentry
         go to 100
       endif         
       return
       end
       function pdbstr(curcat,curnam,curlim,gotnam)
C
C      extracts a value for token "_"//curcat//"."//curnam
C      enforcing a limit of curlim characters
C
C
C      The strange code on result is to avoid rejection of a
C      numeric field if we asked for it as a character field
C
       include 'cif2pdb.cmn'
       logical char_
       character*(*) curcat
       character*(*) curnam
       integer curlim,ll
       character*(*) gotnam
       character*80 temp
       gotnam = ' '
       ll = 1
       if (.not.text_) strg_ = " "
       tmparg = "_"//curcat//"."//curnam
       result = char_(tmparg(1:nblen(tmparg)),temp)
       if (result.or.(type_.eq.'numb')) then
         ll = nblen(temp)
         if (ll.ge.curlim) then
           kpmap = nmap
           tmparg = curnam//":"//temp(1:ll)//char(0)
           call hash_store(tmparg,mapstr,mapchain,
     *       NUMSTR,nmap,mhash,NUMHSH,ifrom)
           if (ifrom.eq.0)
     *       call c2perr(' More than NUMSTR strings mapped ')
           if (ifrom.eq.kpmap+1) mapto(ifrom) = 0
           kfrom = mapto(ifrom)
           if (kfrom.ne.0) then
             temp = mapstr(kfrom)
             ll = nblen(temp)
           endif
           if (ll .gt. curlim) then
             call c2pwarn(' String '//temp(1:ll)//' too long'//
     *       ' truncating to '//temp(1:curlim))
             ll = curlim
             if (kfrom.eq.0) then
               call hash_store(temp(1:ll)//char(0),mapstr,mapchain,
     *           NUMSTR,nmap,mhash,NUMHSH,ito)
               if (ito.eq.0)
     *           call c2perr(' More than NUMSTR strings mapped ')
               mapto(ifrom)=ito
             endif
           endif
         else
           if(ll.eq.0) then
             ll=1
             temp(1:1) = ' '
           endif
         endif
         gotnam = temp(1:ll)
       endif
       pdbstr = result.or.(type_ .eq. 'numb')
       return
       end
       function pdbint(curcat,curnam,curlim,gotint,intval)
C
C      extracts a value for token "_"//curcat//"."//curnam
C      required to be a right justified integer in a field
C      curlim characters wide
C
C
C      The strange code on result is to avoid rejection of a
C      numeric field if we asked for it as a character field
C
       include 'cif2pdb.cmn'
       logical char_
       character*(*) curcat
       character*(*) curnam
       integer curlim,ll
       character*(*) gotint
       real xnumb,xesd
       character*80 temp
       character*20 stars,blanks
       data stars/'********************'/
       data blanks/'                    '/
       gotint = ' '
       intval = 0
       strg_ = " "
       tmparg = "_"//curcat//"."//curnam
       result = char_(tmparg,temp)
       if ((result.or.(type_.ne.'null')).and.
     *   strg_(1:long_).ne." ") then
         ll = nblen(temp)
         if (ll .gt. curlim) then
           call c2pwarn(' found '//temp(1:ll)//
     *   ' too large, converted to'//stars(1:curlim))
           ll = curlim
           temp(1:curlim) = stars(1:curlim)
         endif
         call rjust(temp)
         read(temp,'(i80)',err=105) intval
         go to 110
105      tmparg=' non-numeric field '//
     *     "_"//curcat//"."//curnam//" = "//temp(min(80,81-ll):80)
         call c2pwarn(tmparg(1:nblen(tmparg)))
         intval=0
110      gotint = temp(min(80,81-ll):80)
         if (ll.eq.0 .or. 
     *     (ll.eq.1 .and. type_.eq.'null')) gotint = ' '
       endif
       pdbint = (result.or.(type_ .ne. 'null'))
       return
       end
       function pdbreal(curcat,curnam,curlim,gotreal,realval)
C
C      extracts a value for token "_"//curcat//"."//curnam
C      required to be a right justified integer in a field
C      curlim characters wide
C
C
C      The strange code on result is to avoid rejection of a
C      numeric field if we asked for it as a character field
C
       include 'cif2pdb.cmn'
       logical numb_
       character*(*) curcat
       character*(*) curnam
       integer curlim,ll
       character*(*) gotreal
       real xnumb,xesd
       character*80 temp
       character*20 stars,blanks
       data stars/'********************'/
       data blanks/'                    '/
       gotreal = ' '
       realval = 0.
       strg_ = " "
       tmparg = "_"//curcat//"."//curnam
       xesd = 0.
       result = numb_(tmparg,xnumb,xesd)
       temp = strg_(1:long_)
       if ((result.or.(type_.ne.'null')) .and.
     *   strg_ .ne. " ") then
       ll = nblen(temp)
       if (xesd .ne.0.) then
          ll = index(temp,'(') -1
       endif
       if (ll .gt. curlim) then
         call c2pwarn(' found '//temp(1:ll)//
     *     ' too large, converted to'//stars(1:curlim))
         ll = curlim
         temp(1:curlim) = stars(1:curlim)
       endif
       if (type_.ne.'numb') then
         tmparg=' non-numeric field '//
     *     "_"//curcat//"."//curnam//" = "//temp(1:ll)
         call c2pwarn(tmparg)
       endif
       if (ll.lt.curlim.and.ll.gt.0) then
         temp = blanks(1:curlim-ll)//temp(1:ll)
         ll=curlim
       endif
       gotreal = temp(1:ll)
       if (ll.eq.1 .and. type_.eq.'null') gotreal = ' '
       if(type_.eq.'numb')
     *   realval = xnumb
       else
C         print *,' failed to find '//"_"//curcat//"."//curnam
       endif
       pdbreal = (result.or.(type_ .ne. 'null')).and.
     *   strg_ .ne." "
       return
       end
       function nblen(str)
C
C      variant of lastnb which also detects a null character to
C      terminate a string
C
       character*(*) str
       ll = len(str)
       jj = index(str,char(0))
       if (jj.ne.0) ll = jj-1
       if (ll.eq.0) then
         nblen = 0
         return
       endif
       do ii = 1,ll
       nblen = 1+ll-ii
       if(str(nblen:nblen).ne.' ' .and.
     *   str(nblen:nblen).ne. char(9) ) return
       enddo
       nblen = 0
       return
       end
       subroutine rjust(str)
C
C      right justify string str, in place
C
       character*(*) str
       character*80 blanks
       character*255 xxstr
       blanks = ' '
       ll = len(str)
       ln = nblen(str)
       if (ln.lt.ll .and. ln.gt.0) then
         xxstr(1:ln) = str(1:ln)
         str = blanks(1:ll-ln)//xxstr(1:ln)
       endif
       return
       end
       subroutine ljust(str)
C
C      left justify str in place
C
       character*(*) str
       ll = len(str)
       jj = 1
       do ii = 1,ll
       if (str(ii:ii).ne.' ') go to 100
       enddo
       return
 100   if (ii.eq.1) return
       do kk = ii,ll
         str(jj:jj)=str(kk:kk)
         jj=jj+1
       enddo
       if(jj.le.ll) str(jj:ll) = ' '     
       return
       end

         subroutine c2perr(mess)
C
C        variant of ciftbx err routine for cif2pdb
C
         character*(*) mess
         call c2pmsg('error',mess)
         stop
         end
         subroutine c2pwarn(mess)
C
C        variant of ciftbx warn for cif2pdb
C
         character*(*) mess
         call c2pmsg('warning',mess)
         return
         end
         subroutine c2pmsg(flag,mess)
C
         include   'cif2pdb.cmn'
         character*(*) flag
         character*(*) mess
         character*(MAXBUF)  tline
         integer       ll,ls,ltry,ii,i
C
         tline = ' cif2pdb'
         if (nblen(flag).gt.0) 
     *     tline = tline//' '//flag(1:nblen(flag))
         tline= tline//': '
     *   //outent(1:loutent)//' '//pdbrec
     *   //' line:'
         ll = max(1,lastnb(tline))
         write(iunerr,'(a,i7)')tline(1:ll),pdbline
         ll=len(mess)
         ls=1
100      if(ll-ls.le.79) then
           write(iunerr,'(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(iunerr,'(1X,a)') mess(ls:i-1)
             ls=i+1
             if(ls.le.ll) go to 100
             return
           endif
           enddo
           write(iunerr,'(1X,a)') mess(ls:ltry)
           ls=ltry+1
           if(ls.le.ll) go to 100
           return
         endif  
         end
       function pdbdate(cifdate)
C
C      return a PDB format date (dd-mmm-yy) from a cif format date
C      yyyy-mm-dd
C
       character*9 pdbdate
       character*(*) cifdate
       character*3 months(12)
       character*256 tmparg
       data months/'JAN','FEB','MAR','APR','MAY','JUN','JUL',
     *  'AUG','SEP','OCT','NOV','DEC'/
       read(cifdate,'(i4,1x,i2,1x,i2)',err=100) iyyyy,imm,idd
       if (imm.lt.1.or.imm.gt.12.or.idd.lt.1.or.idd.gt.31)
     *  go to 100
       if (iyyyy.lt.1970.or.iyyyy.gt.2069) go to 100
       write(pdbdate,'(i2.2,1h-,a3,1h-,i2.2)')idd,months(imm),
     * mod(iyyyy,100)
       return
 100   tmparg = ' Unable to translate date: '//cifdate
       call c2pwarn(tmparg)
       pdbdate = '??-???-??'
       return
       end
       function upcase(name)
C
C      convert string name to uppercase
C      derived from ciftbx locase
C
       character    upcase*(255)
       character    temp*(255),name*(*)
       character    low*26,cap*26,c*1
       integer i,j,ll
       data  cap /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
       data  low /'abcdefghijklmnopqrstuvwxyz'/
C
       temp=name
       ll = len(name)
       do 100 i=1,ll
       c=temp(i:i)
       if(c.eq.' ') goto 200
       j=index(low,c)
       if(j.ne.0) temp(i:i)=cap(j:j)        
100    continue
200    upcase=temp
       return
       end
       subroutine splitstr(numf,str,sarry,maxf,fs)
C
C      split the string str into a maximum of maxf fields using the
C      field separator fs.  The number of fields found is reported in
C      numf.  The fields are split into the array sarry, with each
C      field terminated by a null character.
C
C
C      The field separator ' ' is treated as a special case, with
C      full blank and tab removal, and only the count of non-blank
C      fields returned.
C
       integer numf, maxf
       character*(*) str, sarry(maxf), fs
       ll = len(str)
       lfs = len(fs)
       if (fs.eq.' ') lfs = 1
       is = 1
       numf = 0
 100   jj = index(str(is:ll),fs)
       if (fs.eq.' ') then
         jjt = index(str(is:ll),char(9))
         if (jj.ne.0) then
           if (jjt.ne.0) jj = min(jjt,jj)
         else
           jj = jjt
         endif
       endif
       if (jj.eq.0) then
         numf = numf+1
         if (numf.le.maxf) then
           sarry(numf) = str(is:ll)//char(0)
         endif
         return
       else
         if (fs.ne.' ' .or. jj.gt.1) then
         numf = numf+1
           if (numf.le.maxf) then
             if (jj.gt.1) then
               sarry(numf) = str(is:is-1+jj-1)//char(0)
             else
               sarry(numf) = char(0)
             endif
           endif
         endif
         is = is+jj+lfs-1
         if (is.le.ll) go to 100
         if (fs.ne.' ') then 
           numf = numf+1
           if (numf.le.maxf) sarry(numf) = char(0)
         endif
         return
       endif
       end
       function nounder(str)
C
C      convert a string with underscores into a string
C      with underscores replaced by blanks, except when
C      an underscore follows an underscore, in which case
C      the single underscore in included.
C
       character*255 nounder
       character*(*) str
       ll = nblen(str)
       lp = ll
       kp = 1
       ks = 1
       if (ll.gt.0) then
 100     kt = index(str(ks:ll),'_')
         if (kt.eq.0) then
           nounder(kp:lp+1) = str(ks:ll)//char(0)
           return
         else
           nounder(kp:kp+kt-1) = str(ks:ks+kt-1)
           kp=kp+kt
           ks=ks+kt
           if (ks.lt.ll) then
             if (str(ks:ks).eq.'_') then
               ks = ks+1
               lp = lp-1
             else
               nounder(kp-1:kp-1) = ' '
             endif
           else
             nounder(kp-1:kp-1) = ' '
           endif
         endif
         if (ks.le.ll) go to 100
       endif
       nounder(kp:kp) = char(0)
       return
       end
       function typeset(str)
C
C      convert a string with upper and lower case characters
C      into an upper case string with the following typesetting
C      conventions (from pre 1993 PDB format descriptions)
C
C      The string is treated as a blank-delimited set of words
C      where, unless flagged otherwise, the first character is
C      intended to be upper-case and the rest lower-case.  These
C      assumptions are over-ridden by the following codes:
C
C        blank  -- immediately following character is upper-case
C        comma  -- immediately following character is upper-case
C        period -- immediately following character is upper-case
C        left parenthesis
C               -- immediately following character is upper-case
C        asterisk
C               -- immediately following character is upper-case
C               and the asterisk is dropped from the output string
C               (therefore "*" is changed to "(STAR)")
C        slash  -- acts like a caps lock until the end of string,
C               a hyphen or a dollar sign, whichever comes first
C               (therefore "/" is changed to "(SLASH)")
C        dollar sign
C               -- terminates effect of slash, blank, comma period, etc.
C               (therefore "$" is changed to "(DOLLAR)")
C
       character*255 typeset
       character*256 tmparg
       character*(*) str
       character*1 mode,c
       logical upper,lower
       ll = nblen(str)
       lp = ll
       kp = 1
       ks = 1
       mode = " "
       if (ll.gt.0) then
 100     c = str(ks:ks)
         ic = ichar(c)
         upper = (ic.ge.ichar('A')).and.(ic.le.ichar('Z'))
         lower = (ic.ge.ichar('a')).and.(ic.le.ichar('z'))
         if(upper) then
           if(mode.eq.'l') then
             typeset(kp:kp) = "*"
             mode = " "
             if(kp.gt.2) then
               if(typeset(kp-2:kp-2).eq."*") then
                 typeset(kp-2:kp-2) = "/"
                 mode = "/"
                 go to 200
               endif
             endif
             kp=kp+1
             go to 200
           endif
           go to 200
         endif
         if(lower) then
           if(mode.eq." ".or.mode.eq."/") then
             typeset(kp:kp) = "$"
             kp = kp+1
             mode = "l"
           endif
           go to 200
         endif
         if(c.eq."$") then
           typeset(kp:kp+7) = "(DOLLAR)"
           kp = kp+8
           mode = "l"
           go to 300
         endif
         if(c.eq."*") then
           typeset(kp:kp+5) = "(STAR)"
           kp = kp+6
           mode = "l"
           go to 300
         endif
         if(c.eq."/") then
           typeset(kp:kp+6) = "(SLASH)"
           kp = kp+7
           mode = "l"
           go to 300
         endif
         if(c.eq."-") then
           if(mode.eq."/") mode = "l"
         endif
 200     if(lower) c = char(ic+ichar('A')-ichar('a'))
         if (mode.ne."/".and.
     *     (c.eq." ".or.c.eq.",".or.c.eq."(".or.c.eq.".")) 
     *     mode = " "
         if (mode.eq."/".and.
     *     (c.eq." ".or.c.eq.",".or.c.eq."(".or.c.eq.".")) then
           typeset(kp:kp) = "$"
           kp = kp+1
           mode = " "
         endif
         if(mode.eq." " .and.
     *     c.ne." " .and. c.ne."," .and. c.ne.".") mode = "l"
         typeset(kp:kp) = c
         kp = kp+1
 300     ks = ks+1
         tmparg=' Unable to typeset '//str
         if (kp.gt.245) call c2perr(tmparg)
       if (ks.le.ll) go to 100
       endif
       typeset(kp:kp) = char(0)
       return
       end
      function findtag_(name)

      logical findtag_
      include 'ciftbx.sys'
      logical find_,data_
      character*(MAXBUF) locase
      logical result
      character*(*) name
      character*(MAXBUF) string, temp
      integer ii, ifirst
      ifirst = 0
      temp = locase(name)
 200  if (nname.gt.0) then
        call hash_find(temp,
     *    dname,dchain,NUMBLOCK,nname,dhash,NUMHASH,
     *    ii)
        if (ii.gt.0) then
          findtag_ = .true.
          return
        endif
      endif
      if (ifirst.eq.0) then
        result=find_(' ','head',string)
        ifirst = 1
      endif
      result = data_(' ')
      if (.not.result) then
        findtag_ = .false.
        return
      endif
      go to 200
      end

      subroutine tagchk(iremno,iunpdb)
C
C     routine to check data block names aginst the list of tags
C     processed by cif2pdb and prints out all unprocessed tags
C     as part of REMARK iremno
C
      PARAMETER (NUMusdtgs=123)
      include 'ciftbx.sys'
      logical procnam(NUMBLOCK)
C
C     The array usdtgs must contain the names of each of the tags
C     processed by cif2pdb, given in lower case. 
C
      character*(NUMCHAR) usdtgs(NUMusdtgs)
      character*(MAXBUF) string,temp
      character*256 tmparg
      character*11 rempref
      logical result
      logical ploop_
      logical pdata_
      logical prefx_
      logical name_
      logical test_
      logical pfile_
      logical char_
      logical ptext_
      logical pchar_
      logical numd_
      logical pnumd_
      logical find_
      logical data_
      double precision dpn, dpesd
      data usdtgs /
     * '_atom_site.b_iso_or_equiv', '_atom_site.u_iso_or_equiv',
     * '_atom_site.aniso_b[1][1]', '_atom_site.aniso_b[1][2]',
     * '_atom_site.aniso_b[1][3]', '_atom_site.aniso_b[2][2]',
     * '_atom_site.aniso_b[2][3]', '_atom_site.aniso_b[3][3]',
     * '_atom_site.aniso_b[1][1]_esd', '_atom_site.aniso_b[1][2]_esd',
     * '_atom_site.aniso_b[1][3]_esd', '_atom_site.aniso_b[2][2]_esd',
     * '_atom_site.aniso_b[2][3]_esd', '_atom_site.aniso_b[3][3]_esd',
     * '_atom_site.aniso_u[1][1]', '_atom_site.aniso_u[1][2]',
     * '_atom_site.aniso_u[1][3]', '_atom_site.aniso_u[2][2]',
     * '_atom_site.aniso_u[2][3]', '_atom_site.aniso_u[3][3]',
     * '_atom_site.aniso_u[1][1]_esd', '_atom_site.aniso_u[1][2]_esd',
     * '_atom_site.aniso_u[1][3]_esd', '_atom_site.aniso_u[2][2]_esd',
     * '_atom_site.aniso_u[2][3]_esd', '_atom_site.aniso_u[3][3]_esd',
     * '_atom_site.auth_asym_id', '_atom_site.auth_seq_id',
     * '_atom_site.cartn_x', '_atom_site.cartn_y', '_atom_site.cartn_z',
     * '_atom_site.fract_x', '_atom_site.fract_y', '_atom_site.fract_z',
     * '_atom_site.footnote_id',
     * '_atom_site.group_pdb',
     * '_atom_site.id',
     * '_atom_site.label_alt_id', '_atom_site.label_asym_id',
     * '_atom_site.label_atom_id', '_atom_site.label_comp_id',
     * '_atom_site.label_entity_id', '_atom_site.label_seq_id',
     * '_atom_site.label_model_id', '_atom_site.occupancy',
     * '_atom_site.type_symbol',
     * '_atom_sites.fract_transf_matrix[1][1]',
     * '_atom_sites.fract_transf_matrix[1][2]',
     * '_atom_sites.fract_transf_matrix[1][3]',
     * '_atom_sites.fract_transf_matrix[2][1]',
     * '_atom_sites.fract_transf_matrix[2][2]',
     * '_atom_sites.fract_transf_matrix[2][3]',
     * '_atom_sites.fract_transf_matrix[3][1]',
     * '_atom_sites.fract_transf_matrix[3][2]',
     * '_atom_sites.fract_transf_matrix[3][3]',
     * '_atom_sites.fract_transf_vector[1]',
     * '_atom_sites.fract_transf_vector[2]',
     * '_atom_sites.fract_transf_vector[3]',
     * '_audit_author.name', '_cell.z_pdb',
     * '_cell.angle_alpha', '_cell.angle_beta', '_cell.angle_gamma',
     * '_cell.length_a', '_cell.length_b', '_cell.length_c',
     * '_chem_comp.id',
     * '_chem_comp.mon_nstd_flag',
     * '_citation.id',
     * '_citation.coordinate_linkage',
     * '_citation.title', '_citation.country',
     * '_citation.journal_abbrev', '_citation.journal_volume',
     * '_citation.journal_issue', '_citation.page_first',
     * '_citation.year',
     * '_citation.journal_coden_astm',
     * '_citation.journal_coden_issn',
     * '_citation.journal_coden_csd', '_citation.journal_id_astm',
     * '_citation.journal_id_issn', '_citation.journal_id_csd',
     * '_citation.book_id_isbn',
     * '_citation.book_title',
     * '_citation.book_publisher',
     * '_citation.book_coden_isbn',
     * '_citation.details',
     * '_citation_editor.citation_id',
     * '_citation_editor.name',
     * '_citation_author.citation_id',
     * '_citation_author.name',
     * '_database_2.database_code',
     * '_database_pdb_remark.id',
     * '_database_pdb_remark.text',
     * '_database_pdb_rev.date_original',
     * '_database_pdb_caveat.id',
     * '_database_pdb_matrix.origx[1][1]',
     * '_database_pdb_matrix.origx[1][2]',
     * '_database_pdb_matrix.origx[1][3]',
     * '_database_pdb_matrix.origx[2][1]',
     * '_database_pdb_matrix.origx[2][2]',
     * '_database_pdb_matrix.origx[2][3]',
     * '_database_pdb_matrix.origx[3][1]',
     * '_database_pdb_matrix.origx[3][2]',
     * '_database_pdb_matrix.origx[3][3]',
     * '_database_pdb_matrix.origx_vector[1]',
     * '_database_pdb_matrix.origx_vector[2]',
     * '_database_pdb_matrix.origx_vector[3]',
     * '_entity.id',
     * '_entity.type',
     * '_entity_poly_seq.entity_id',
     * '_entity_poly_seq.mon_id',
     * '_entity_poly_seq.num',
     * '_exptl.method',
     * '_exptl.details',
     * '_struct.title',
     * '_struct_asym.entity_id',
     * '_struct_asym.id',
     * '_struct_biol.details',
     * '_struct_keywords.entry_id',
     * '_struct_keywords.text',
     * '_symmetry.space_group_name_h-m'/
C
C     Mark names as false in procnam
C
      do ii = 1,NUMBLOCK
      procnam(ii) = .false.
      enddo
C
C     Mark the names that cif2pdb processes as true
C
      do ii = 1, NUMusdtgs
        call hash_find(usdtgs(ii),
     *    dname,dchain,NUMBLOCK,nname,dhash,NUMHASH,
     *    iname)
          if (iname.gt.0) procnam(iname) = .true.
      end do
      write(rempref,'(a6,i4,1x)')'REMARK',iremno
      write(iunpdb,'(a)') rempref
      write(iunpdb,'(a)') rempref//'EMBEDDED CIF'
      result=prefx_(rempref,11)
      line_=70
      result=pfile_(' ')
      if(.not.result) then
        call c2perr(
     *  ' failed to open file for insertion of cif')
      endif
      result=find_(' ','head',string)
200   call cpcmnt
      result=data_(' ')
      if (result) go to 210
900     call cpcmnt
        call close_
        return
210   string=bloc_
      saveo_=save_
      result=pdata_(string)
      if(.not.result) then
          call c2perr(
     *    ' duplicate data block '//bloc_)
      endif
      tabl_=.false.
      align_=.false.
      ixname=1
250   if(ixname.le.nname) then
        loop_ = .false.
        if(nloop(ixname).ne.0) then
          iyname=ixname
          igood=0
          do ii = ixname,nname
            if(nloop(ixname).ne.nloop(ii)) go to 260
            if(.not.procnam(ii)) igood=igood+1
            iyname=ii
          enddo
260       continue
          if(igood.ne.0) then
C
C         We have a loop to process, force category keys back in
C
          if (ndict.gt.0) then
          do ii = ixname,iyname
            kd = ddict(ii)
            if (kd.ne.0) then
              if (aroot(kd).ne.0) kd=aroot(kd)
              if (catkey(kd)) procnam(ii) = .false.
            endif
          enddo
          endif
          do ii = ixname,iyname
            call cpcmnt
            result=name_(string)
            if(.not.procnam(ii)) then
              pposval_ = 1
              pposnam_=posnam_
              result=ploop_(string(1:max(1,lastnb(string))))
            endif
          enddo
          tabl_ = .false.
          align_ = .false.
          if(igood.lt.iyname-ixname+1) then
            tabl_ = .true.
          endif
270       do ii = ixname,iyname
            if(.not.procnam(ii)) then
            call cpcmnt
            result=test_(dname(ii))
            pposnam_=posnam_
            pposval_=posval_
            pposdec_=posdec_
            pposend_=posend_
            if(posend_.gt.59) then
              pposnam_=max(0,pposnam_-21)
              pposval_=max(0,pposval_-21)
              pposdec_=max(0,pposdec_-21)
              pposend_=max(0,pposend_-21)
            endif
            if (tabl_) then
              pposnam_=0
              pposval_=0
              pposdec_=0
              pposend_=0
            endif
            if(type_.eq.'null') then
              if (long_.eq.1.and.strg_(1:1).eq.'?') then
                 result=pchar_(' ','?')
              else
                 result=pchar_(' ','.')
              endif
              type_=' '
            endif
            if(type_.eq.'char') then
               result=char_(dname(ii),string)
               if(string.eq.'?'.or.string.eq.'.') then
                 tmparg=''''//
     *             string(1:1)//''''
                 result=pchar_(' ',tmparg)
               else
                 result=pchar_(' ',string(1:max(1,lastnb(string))))
               endif
               type_=' '
            endif
            if(type_.eq.'numb') then
              dpesd=0.0D0
              result=numd_(dname(ii),dpn,dpesd)
              plzero_=lzero_
              result=pnumd_(' ',dpn,dpesd)
            endif
            if(type_.eq.'text') then
280           result=char_(dname(ii),string)
              ll=lastnb(string)
              ls=1
              if(string(1:2).eq.'  ') ls=3
              if(ll-ls+1.le.59) then
              result=ptext_(' ',string(ls:max(ls,lastnb(string))))
              else
              result=ptext_(' ',string(ls:59))
              result=ptext_(' ',string(60:max(ls,lastnb(string))))
              endif
              if(text_) go to 280
              call eotext
              type_=' '
            endif
            endif
          enddo
          if(loop_) go to 270
          endif
          ixname=iyname+1
          go to 250
        else
          call cpcmnt
          result=name_(temp)
          if(.not.result)
     *      call c2perr(' misaligned data item '//dname(ixname))
          call cpcmnt
          if(.not.procnam(ixname)) then
          tabl_ = .false.
          result=test_(dname(ixname))
          pposnam_=posnam_
          pposval_=posval_
          pposdec_=posdec_
          pposend_=posend_
          if(posend_.gt.59) then
            pposnam_=max(0,pposnam_-21)
            pposval_=max(0,pposval_-21)
            pposdec_=max(0,pposdec_-21)
            pposend_=max(0,pposend_-21)
          endif
          if(type_.eq.'null') then
            if (long_.eq.1.and.strg_(1:1).eq.'?') then
               result=pchar_(temp,'?')
            else
               result=pchar_(temp,'.')
            endif
            type_=' '
          endif  
          if(type_.eq.'char') then
            result=char_(temp,string)
            if(string.eq.'?'.or.string.eq.'.') then
              result=pchar_(temp,''''//
     *          string(1:1)//'''')
            else
              result=pchar_(temp,string(1:max(1,lastnb(string))))
            endif
            type_=' '
          endif
          if(type_.eq.'numb') then
            dpesd=0.0D0
            result=numd_(temp,dpn,dpesd)
            plzero_=lzero_
            result=pnumd_(temp,dpn,dpesd)
          endif
          if(type_.eq.'text') then
290         result=char_(temp,string)
            ll=lastnb(string)
            ls=1
            if(string(1:2).eq.'  ') ls=3
            if(ll-ls+1.le.59) then
            result=ptext_(' ',string(ls:max(ls,lastnb(string))))
            else
            result=ptext_(' ',string(ls:59))
            result=ptext_(' ',string(60:max(ls,lastnb(string))))
            endif
            if(text_) go to 290
            call eotext
            type_=' '
          endif
          endif
        endif
        ixname=ixname+1
        go to 250
      endif
      go to 200
C
      END
C
C
      subroutine cpcmnt
C
C     routine to copy a set of comments (if any) from the
C     input cif to the output cif
C
      include 'cif2pdb.cmn'
      logical pcmnt_
      logical cmnt_
      character*(MAXBUF) string,temp
100   result=cmnt_(string)
      if (result) then
        if(long_+posnam_.le.55) then
        pposnam_=posnam_
        result=pcmnt_(string(1:long_))
        else
        pposnam_=min(17,posnam_)
        result=pcmnt_(string(1:40))
        pposnam_=17
        result=pcmnt_(string(41:long_))
        endif
        goto 100
      endif
      return
      end
       subroutine ssort(strg,nstrg,nchr,norder)
C
C      simple sort routine to establish order of array
C      strg of nstrg string of length nchr in array norder
C      no attempt is made to remove duplicates nor to
C      preserve the initial ordering of duplicates.
C
C      Herbert J. Bernstein, Bernstein+Sons, 13 July 1996
C
       integer nstrg, nchr, ns, ii, jj, ilow, ihigh, imid
       integer norder(nstrg)
       character*(*) strg(nstrg)
       norder(1)=1
       ns=1
       do ii = 2,nstrg
       ilow = 1
       ihigh = ns
 100   imid = (ilow+ihigh+1)/2
       if (ihigh-ilow.le.1) then
       if (strg(ii) .ge. strg(norder(ilow)).and.
     *     strg(ii) .le. strg(norder(ihigh))) then
         do jj = ns,ihigh,-1
           norder(jj+1) = norder(jj)
         enddo
         norder(ihigh) = ii
         ns=ns+1
         go to 200
       endif
       endif
       if (strg(ii) .ge. strg(norder(ihigh))) then
         do jj = ns,ihigh+1,-1
           norder(jj+1) = norder(jj)
         enddo
         norder(ihigh+1) = ii
         ns=ns+1
       else
         if (strg(ii) .le. strg(norder(ilow))) then
           do jj = ns,ilow,-1
             norder(jj+1) = norder(jj)
           enddo
           norder(ilow) = ii
           ns=ns+1
         else
           if (strg(ii) .le. strg(norder(imid))) then
             ihigh = imid
           else
             ilow = imid
           endif
           go to 100
         endif
       endif
 200   continue
       enddo
       return
       end
       subroutine cell2mat(cell,matf2o,mato2f)
C
C      cell2mat -- convert a cell to matrices
C
C      Herbert J. Bernstein, yaya@bernstein-plus-sons.com
C      20 May 1998
C
C      Creates matrices for an orthogonal system with
C         a along x, b in the x-y plane
C
C      cell   - real*8 array of a, b, c, alpha, beta, gamma
C      matf2o - real*8 3x3 matrix to convert from fractional
C               to orthogonal
C      mato2f - real*8 3x3 matrix to convert from orthogonal
C               to fractional
C
       real*8 cell(6),matf2o(3,3),mato2f(3,3)
       real*8 cell_a, cell_b, cell_c
       real*8 cell_alpha, cell_beta, cell_gamma
       real*8 pi,torad
       data pi/3.14159 26535 9 d0/
       torad = pi/180.d0
       cell_a = cell(1)
       cell_b = cell(2)
       cell_c = cell(3)
       cell_alpha = cell(4)
       if (abs(cell(4)).lt.1.d0) 
     *   cell_alpha = acos(cell(4))*180.d0/pi
       cell_beta  = cell(5)
       if (abs(cell(5)).lt.1.d0)
     *   cell_beta  = acos(cell(5))*180.d0/pi
       cell_gamma = cell(6)
       if (abs(cell(6)).lt.1.d0)
     *   cell_gamma = acos(cell(6))*180.d0/pi
       cell_vol = cell_a*cell_b*cell_c *
     *  (1.d0 - (cos(torad*cell_alpha))**2 
     *         -(cos(torad*cell_beta))**2
     *         -(cos(torad*cell_gamma))**2
     *         +2*cos(torad*cell_alpha)
     *           *cos(torad*cell_beta)
     *           *cos(torad*cell_gamma))
       do ii = 1,3
         do jj = 1, 3
           matf2o(ii,jj) = 0.d0
           mato2f(ii,jj) = 0.d0
         enddo
       enddo
       matf2o(1,1) = cell_a
       matf2o(1,2) = cell_b*cos(torad*cell_gamma)
       matf2o(2,2) = cell_b*sin(torad*cell_gamma)
       matf2o(1,3) = cell_c*cos(torad*cell_beta)
       matf2o(2,3) = cell_c*(cos(torad*cell_alpha)
     *                 -cos(torad*cell_beta)
     *                 *cos(torad*cell_gamma))
     *                 /sin(torad*cell_gamma)
       matf2o(3,3) = sqrt(cell_c**2-matf2o(1,3)**2
     *                -matf2o(2,3)**2)
       mato2f(1,1) = 1.d0/matf2o(1,1)
       mato2f(2,2) = 1.d0/matf2o(2,2)
       mato2f(3,3) = 1.d0/matf2o(3,3)
       mato2f(1,2) = -matf2o(1,2)
     *                 /(matf2o(1,1)*matf2o(2,2))
       mato2f(2,3) = -matf2o(2,3)
     *                 /(matf2o(2,2)*matf2o(3,3))
       mato2f(1,3) = -mato2f(1,1)*
     *                 (matf2o(1,2)*mato2f(2,3)
     *                 +matf2o(1,3)*mato2f(3,3))
       return
       end
       subroutine matmul(mat1,mat2,mat3)
C
C      multiply mat1 times mat2 and return mat3
C
C      Herbert J. Bernstein, yaya@bernstein-plus-sons.com
C      20 May 1998
C              
       real*8 mat1(3,3), mat2(3,3), mat3(3,3)
       do ii = 1,3
       do jj = 1,3
       mat3(ii,jj) = 0
       do kk = 1,3
       mat3(ii,jj) = mat3(ii,jj) + mat1(ii,kk)*mat2(kk,jj)
       enddo
       enddo
       enddo
       return
       end
       real*8 function det(mat)
C
C      compute the real*8 determinant of a real*8 matrix
C
C      Herbert J. Bernstein, yaya@bernstein-plus-sons.com
C      6 March 1998
C              
       real*8 mat(3,3)       
       det =
     *  (mat(1,1)*mat(2,2)*mat(3,3)
     *  + mat(2,1)*mat(3,2)*mat(1,3)
     *  + mat(3,1)*mat(1,2)*mat(2,3)
     *  - mat(1,3)*mat(2,2)*mat(3,1)
     *  - mat(1,2)*mat(2,1)*mat(3,3)
     *  - mat(1,1)*mat(2,3)*mat(3,2))
       return
       end
       subroutine invxfrm(mato2f,veco2f,matf2o,vecf2o)
C
C      compute the inverse of a tranform
C
C      Herbert J. Bernstein, yaya@bernstein-plus-sons.com
C      6 March 1998
C
C      mato2f - 3x3 real*8 input matrix
C      veco2f - 3 element real*8 input vector
C      matf2o - 3x3 real*8 output matrix
C      vecf2o - 3 element real*8 output vector
C
C      matf2o is the inverse of mato2f
C      vecf2o = -matf2o veco2f

       real*8 mato2f(3,3),veco2f(3),matf2o(3,3),vecf2o(3)
       real*8 newvol, det
       newvol = 1.d0/det(mato2f)
       matf2o(1,1) = newvol
     *  * (mato2f(2,2)*mato2f(3,3)-mato2f(3,2)*mato2f(2,3))
       matf2o(2,1) = newvol
     *  * (mato2f(2,3)*mato2f(3,1)-mato2f(3,3)*mato2f(2,1))
       matf2o(3,1) = newvol
     *  * (mato2f(2,1)*mato2f(3,2)-mato2f(3,1)*mato2f(2,2))

       matf2o(1,2) = newvol
     *  * (mato2f(1,3)*mato2f(3,2)-mato2f(1,2)*mato2f(3,3))
       matf2o(2,2) = newvol
     *  * (mato2f(1,1)*mato2f(3,3)-mato2f(1,3)*mato2f(3,1))
       matf2o(3,2) = newvol
     *  * (mato2f(1,2)*mato2f(3,1)-mato2f(1,1)*mato2f(3,2))

       matf2o(1,3) = newvol
     *  * (mato2f(1,2)*mato2f(2,3)-mato2f(1,3)*mato2f(2,2))
       matf2o(2,3) = newvol
     *  * (mato2f(1,3)*mato2f(2,1)-mato2f(1,1)*mato2f(2,3))
       matf2o(3,3) = newvol
     *  * (mato2f(1,1)*mato2f(2,2)-mato2f(1,2)*mato2f(2,1))
       
       do ii = 1,3
       vecf2o(ii) = 0.d0
       do jj = 1,3
       vecf2o(ii) = vecf2o(ii) - matf2o(ii,jj)*veco2f(jj)
       enddo
       enddo
       return
       end
