*cpl
*lst
*ident up1
*/ 1 jun 92 -- fix paging problem for vector data
*d bbc.793
      if (ird(8).ne.1) go to 405
*d bbc.826
  405 nwds=nw
*ident up2
*/ 14 jan 92 -- fix problems with hollerith variables
*d bbc.97
      parameter (nucs=300,nvec=150)
*i bbc.121
      data hmatx/6hmatxs /, htext/6htext  /, hind/6hindex /
      data hmodin/6hmodinp/, hmodo/6hmodout/
      data hi/6hi     /, hii/6hI     /
      data hs/6hs     /, hss/6hS     /
*d bbc.190
      if (hoper(k).eq.hi.or.hoper(k).eq.hii) needmf=1
*d bbc.224
      hin=hmatx
*d bbc.227
      hin=htext
*d bbc.237
      hout=hmatx
*d bbc.240
      hout=htext
*d bbc.245
      hmodi=hblank
*d bbc.250
      hmodi=hmodin
*d bbc.256
      hout=hmodo
*d bbc.261
      hindx=hind
*d bbc.335
*d bbc.375
*d bbc.425
      if (hoper(i).ne.hs.and.hoper(i).ne.hss) go to 250
*d bbc.436
  250 if (hoper(i).ne.hi.and.hoper(i).ne.hii) go to 270
*d bbc.566
*d bbc.1149
      real*8 hname,hchang
*d bbc.1151
      integer hname,hchang
*i bbc.1157
      data hchang/6hchange/
*d bbc.1159
      if (hname.eq.hchang) go to 210
*/ 19 jan 93 -- remove variable format
*d bbc.100
*d bbc.116
*i bbc.117
      character*13 aform(8)
*d bbc.122,124
*d bbc.792
*d bbc.800
      aform(kn)='             '
*d bbc.815,816
      write(aform(jn),'(1p,e13.3)') a(lin)
*d bbc.818
  375 aform(jn)='             '
*d bbc.821,822
      write(nsyso,'(i5,8a13)') in,(aform(jn),j=1,nw)
*/ 19 jan 93 -- fix problem with matrix subblocks
*d bbc.905
  495 if (nwds.eq.0) go to 550
*ident up3
*/ 29 sep 93 -- more fixes to paging
*d bbc.808
      n=nblk-mblk+1
*d bbc.810
      do 380 jn=1,n
*/ 29 sep 93 -- remove extraneous format statement
*d bbc.1233
*ident up4
*/ 25 oct 93 -- fix problem with ncw for short-word versions
*d bbc.135
      ncw=8
*/ jan 1994 add ability to merge single matxs files
*i bbc.71
c                       m  merge materials from single material files
c                          the file names must be the same as the material
c                          names given as hmat1
*i up2.9
      data hm/6hm     /, hmm/6hM     /
*i bbc.181
      needmg=0
*i up2.11
      if (hoper(k).eq.hm.or.hoper(k).eq.hmm) needmg=1
*i bbc.194
c     ** read in new file bcd file information
*i bbc.219
c
c     ***if merging files check input and set up files
 170  if(needmg.eq.1) then
        do 166 k=1,nmodc
        if (hoper(k).ne.hm.and.hoper(k).ne.hmm)
     x     call error('when merging files cannot invoke other options')
 166    continue
        call seek (hmat1(1),0,nin,0)
        hout = 'matxs'
        call seek (hout,0,nout,1)
        go to 195
      endif
*d bbc.222
      if (iinpf.gt.0) then
*i bbc.423
      if (needmg.eq.1) then
        hmatm(1) = hmat1(1)
        lmatm(1) = 0
        lmatm(2)=length-7
        l2=l2+nmodc-1
        do 238 i=2,nmodc
c      *** loop through files to be merged - get lengths
        call seek (hmat1(i),0,iu,0)
        nwb=4*mult+6
        ibb=20000
        nw=3*mult+1
        call reed (iu,1,a(ibb),nw,1)
        call reed (iu,2,a(ibb+nw),6,1)
        l= ia(ibb+nw+5)
        length=length+l-7
        if (i.lt.nmodc) lmatm(i+1)=lmatm(i)+l-7
        nsubm(1)=nsubo(1)
        hmatm(i)=hmat1(i)
        nw=mult*(npart+ntype+1)+2*ntype+npart+2
        call reed(iu,4,a(ibb),nw,1)
        nsubm(i)=ia(ibb+nw-2)
        close (iu)
 238    continue
        nmat=nmodc
        nex2= nex1+nmat*mult+npart+2*ntype
        nex3= nex2+nmat
        n=npart+2*ntype
        do 237 i=n,1,-1
 237    ia(nex1+nmat*mult+i) = ia(nex1+nmato*mult+i)
        do 239 i=1,nmat
        ha(nex1h+i)=hmat1(i)
        ia(nex2+i)=nsubm(i)
 239    ia(nex3+i)=lmatm(i)
        go to 290
      endif
*i bbc.631
      if (needmg.eq.1) then
        nsub=nsubm(imm)
        irec3=7
        if(imm.ne.1) then
          close (iu)
          call seek (hmat1(imm),0,iu,0)
          call repoz(iu)
          call reed(iu,1,a(l2),3*mult+1,0)
        else
          iu=nin
        endif
        nwds=mult+1+6*nsub
        call reed(iu,irec3,a(l2),nwds,1)
        go to 326
      endif
*d bbc.666
*i bbc.668
 326  ireco=ireco+1
*i bbc.721
      if(needmg.eq.1) then
        irec3=irec3+1
        call reed(iu,irec3,a(l3),nwds,1)
        go to 349
      endif
*d bbc.737
 349  ireco=ireco+1
*i bbc.776
      if (needmg.eq.1) then
        irec3=irec3+1
        call reed(iu,irec3,a(l4),nwds,1)
        go to 361
      endif
*d bbc.788
 361  ireco=ireco+1
*d up2.57
      write(nsyso,'(i5,8a13)') in,(aform(jn),jn=1,n)
*i bbc.837
      if (needmg.eq.1) then
        irec3=irec3+1
        call reed(iu,irec3,a(l3),nwds,1)
        go to 455
      endif
*d bbc.853
 455  ireco=ireco+1
*i bbc.907
      if (needmg.eq.1) then
        irec3=irec3+1
        call reed(iu,irec3,a(l4),nwds,1)
        go to 496
      endif
*d bbc.919
496   ireco=ireco+1
*i bbc.959
      if (needmg.eq.1) then
        irec3=irec3+1
        call reed(iu,irec3,a(l4),nwdc,1)
        go to 551
      endif
*d bbc.969
 551  if (nout.gt.0) call rite(nout,ireco,a(l4),nwdc,0)
*ident up5
*/ 9 nov 94 -- generalize to work with directories of files
*d bbc.5
c     convert mode, list, index, or modify matxs files.
c     either multi-material matxs files or sets of
c     single-material files are allowed.
*i bbc.30
c
c     a multi-material matxs file can be exploded into a set of
c     single-material files, with mode conversion, if desired.  
c     a set of single-material files can have the mode changed for 
c     each file, or the files can be imploded into a multi-material 
c     file, including mode conversion, listing, and/or indexing.
*d bbc.39,40
c                       2  binary file set (named by mat)
c                       1  binary file (matxs)
c                      -1  coded file (text)
c                      -2  coded file set (named by mat)
*d bbc.42,44
c                       2  binary file set (named by mat)
c                       1  binary file (matxs or modout)
c                       0  none
c                      -1  coded file (text)
c                      -2  coded file set (named by mat)
*d bbc.54
c     card 2   (iinpf.eq.2.or.iinpf.eq.-2 only)
c          diri      input directory for set of files.
c                    use *name/*/ (24 chars max).
c     card 3   (ioutf.eq.2.or.ioutf.eq.-2 only)
c          diro      output directory for set of files.
c                    use *name/*/ (24 chars max).
c     card 4   (ilist.ne.0 only)
*d bbc.47
c                       1  modifications given (modinp)
*d bbc.49,50
c                       0  not listed (default)
c                       1  listed
*d bbc.68
c     card 5   (imodf.ne.0 only)
*d up4.7,9
*d bbc.74
c
*d bbc.77
c     card 6    (iinpf.eq.2 or iinpf.eq.-2 only)
c          hmati     list of materials in the set to
c                    be written into the output matxs file,
c                    given in the order desired.
c     card 7    (modifying or imploding only)
c            modifying is implied by imodf.ne.0.  imploding is
c            implied by iabs(iinpf).eq.2 and iabs(ioutf).ne.2.
*d bbc.81
c     card 8    (modifying or imploding only)
*d bbc.84
c        repeat card 8 for each line of the new hollerith
*d bbc.104
      dimension a(30000)
*i bbc.114
      dimension hmati(nucs)
      dimension jgrt(10)
*i bbc.119
      character*24 diri,diro
      character*30 sin,sout
*d up4.11
      data hexplod/8hexploded/
*d bbc.158
      z(4)=0
*d bbc.166,169
      if (imodf.eq.1.and.iinpf.lt.0)
     x call error('input must be binary for imodf=1')
      if (iabs(iinpf).eq.2.and.imodf.eq.1)
     x call error('mods cannot be used with input sets')
      if (iabs(iinpf).eq.2) then
         nz=6
         do 101 i=1,nz
  101    z(i)=blank
         call free(nsysi,z,nz,4)
         write(diri,'(6a4)') (z(i),i=1,nz)
      endif
      if (iabs(ioutf).eq.2) then
         nz=6
         do 102 i=1,nz
  102    z(i)=blank
         call free(nsysi,z,nz,4)
         write(diro,'(6a4)') (z(i),i=1,nz)
      endif
      do 103 i=1,nrd
  103 ird(i)=0
*d bbc.180
      if (imodf.ne.1) go to 125
*d up4.13
*d up4.15
*d up4.17
c
c     ***read in implosion specs
  125 nmati=0
      if (iabs(iinpf).ne.2) go to 130
      nmati=nucs
      call free(nsysi,hmati,nmati,ncw)
c
c     ***read in new file information text
*d bbc.195
  130 if (imodf.eq.1) go to 135
      if (iabs(iinpf).eq.2.and.iabs(ioutf).ne.2) go to 135
      go to 170
  135 nmodc=k
*d up4.19,up4.30
  170 continue
*d bbc.220,258
*d bbc.259
  195 indxx=0
*d bbc.262
      indxx=4
*d bbc.263
      open(indxx,file='index',status='unknown',
*d bbc.265
      write(indxx,'('' index to matxs file'')')
*d bbc.269,276
      write(nsyso,'(/
     x  '' input file type ....................... '',i4/
     x  '' output file type ...................... '',i4/
     x  '' modify flag ........................... '',i4/
     x  '' list option ........................... '',i4/
     x  '' indexing option ....................... '',i4)')
     x iinpf,ioutf,imodf,list,indx
      if (iabs(iinpf).eq.2) write(nsyso,'(
     x  '' input directory ....................... '',a)')
     x  diri
      if (iabs(ioutf).eq.2) write(nsyso,'(
     x  '' output directory ...................... '',a)')
     x  diro
*d bbc.280,288
      if (imodf.eq.1) go to 202
      if (iabs(iinpf).eq.2.and.iabs(ioutf).ne.2) go to 206
      go to 204
  202 write(nsyso,'(/
*d bbc.291
      do 203 i=1,nmodc
*d bbc.293
  203 continue
  204 if (iabs(iinpf).ne.2) go to 205
      write(nsyso,'(/
     x '' materials for implosion or conversion''/
     x '' -------------------------------------'')')
      write(nsyso,'(5x,5a10)') (hmati(i),i=1,nmati)
  205 if (imodf.eq.0) go to 210
      if (iabs(ioutf).eq.2) go to 210
*d bbc.294
  206 write(nsyso,'(/
*d bbc.301
  210 continue
c
c     ***open main output files, if needed.
      if (imodf.ne.0) then
         nop=1
         write(sout,'(a6)') hmodo
         call seek(sout,0,nout,nop)
      else if (ioutf.eq.1) then
         nop=1
         write(sout,'(a6)') hmatx
         call seek(sout,0,nout,nop)
      else if (ioutf.eq.-1) then
         nop=7
         write(sout,'(a6)') htext
         call seek(sout,0,nout,nop)
         nout=-nout
      endif
*i bbc.304
      hmodi=hmodin
      nop=0
      if (imodf.lt.0) nop=6
      write(sin,'(a6)') hmodi
      call seek(sin,0,nmodi,nop)
*i bbc.326
      last=ia(ib+nw+5)
*d bbc.353,354
c     ***read in data from main or first input file
  220 if (iinpf.eq.1) then
         nop=0
         write(sin,'(a6)') hmatx
         call seek(sin,0,nin,nop)
      else if (iinpf.eq.-1) then
         nop=6
         write(sin,'(a6)') htext
         call seek(sin,0,nin,nop)
         nin=-nin
      else if (iinpf.eq.2) then
         nop=0
         lb=index(diri,' ')-1
         write(sin,'(a,a6)') diri(1:lb),hmati(1)
         call seek(sin,0,nin,nop)
      else if (iinpf.eq.-2) then
         nop=6
         lb=index(diri,' ')-1
         write(sin,'(a,a6)') diri(1:lb),hmati(1)
         call seek(sin,0,nin,nop)
         nin=-nin
      endif
c
c     ***file identification
      nwb=4*mult+6
*d bbc.411
      if (imodf.ne.0) go to 231
      if (iabs(iinpf).eq.2.and.iabs(ioutf).ne.2) go to 231
      go to 290
*d bbc.414
  231 ha(ibh+1)=hum
*d bbc.419,420
*d up4.34,68
c
c     ***get new information from implosion file set
      if (iabs(iinpf).ne.2) go to 238
      hmatm(1)=hmati(1)
      lmatm(1)=0
      lmatm(2)=length-7
      l2=l2+nmati-1
      do 232 i=2,nmati
      if (iinpf.gt.0) nop=0
      if (iinpf.lt.0) nop=6
      lb=index(diri,' ')-1
      write(sin,'(a,a6)') diri(1:lb),hmati(i)
      call seek(sin,0,iu,nop)
      if (iinpf.lt.0) iu=-iu
      nwb=4*mult+6
      ibb=l2
      ibbh=(ibb-1)/mult+1
      nw=3*mult+1
      if (iu.gt.0) call reed(iu,1,a(ibb),nw,1)
      if (iu.lt.0) read(-iu,'(4x,a8,1x,2a8,1x,i6)')
     x (ia(ibb-1+ii),ii=1,nw)
      if (iu.gt.0) call reed(iu,2,a(ibb+nw),6,1)
      if (iu.lt.0) read(-iu,'(6x,6i6)')
     x (ia(ibb+nw-1+ii),ii=1,6)
      l=ia(ibb+nw+5)
      length=length+l-7
      if (i.lt.nmati) lmatm(i+1)=lmatm(i)+l-7
      nsubm(1)=nsubo(1)
      hmatm(i)=hmat1(i)
      nh=ia(ibb+nw+2)
      nw=nh*mult
      if (iu.gt.0) call reed(iu,3,a(ibb),nw,1)
      if (iu.lt.0) read(-iu,'(4x/(9a8))')
     x (ha(ibbh-1+ii),ii=1,nh)
      nw=mult*(npart+ntype+1)+2*ntype+npart+2
      ndr=npart+ntype+nmat
      nir=npart+2*ntype+2*nmat
      ibbh=(ibb-1)/mult+1
      if (iu.gt.0) call reed(iu,4,a(ibb),nw,1)
      if (iu.lt.0) read(-iu,'(8x,8a8/(9a8))')
     x (ha(ibbh+ii-1),ii=1,ndr)
      if (iu.lt.0) read(-iu,'(12i6)')
     x (ia(ibb+ndr*mult-1+ii),ii=1,nir)
      nsubm(i)=ia(ibb+nw-2)
      close(iabs(iu))
  232 continue
      nmat=nmati
      nex2=nex1+nmat*mult+npart+2*ntype
      nex3=nex2+nmat
      n=npart+2*ntype
      do 234 i=n,1,-1
  234 ia(nex1+nmat*mult+i)=ia(nex1+nmato*mult+i)
      do 236 i=1,nmat
      ha(nex1h+i)=hmati(i)
      ia(nex2+i)=nsubm(i)
  236 ia(nex3+i)=lmatm(i)
      go to 290
c
c     ***get new info from modification commands
*d bbc.424
  238 do 270 i=1,nmodc
*d bbc.505
      if (indxx.gt.0) write(indxx,'(/
*i bbc.537
      else if (iabs(iinpf).eq.2.and.iabs(ioutf).eq.1) then
         inow=ihollm
         nhh=nhollm
*d bbc.551,552
      if (indxx.gt.0)
     x  write(indxx,'(/'' file description''//(2x,9a8))')
*i bbc.555
      nmt=nmat
*d bbc.571
      if (indxx.gt.0) write(indxx,'(/
*d bbc.577
      if (indxx.gt.0) write(indxx,'(i9,7x,a8,i5)')
*d bbc.582
      if (indxx.gt.0) write(indxx,'(/
*d bbc.591
      if (indxx.gt.0) write(indxx,'(i9,7x,a8,i5,i9)')
*d bbc.596
      if (indxx.gt.0) write(indxx,'(/
*d bbc.605
      if (indxx.gt.0) write(indxx,'(i9,7x,a8,i5,i9)')
*i bbc.610
      jgrt(ipart)=l2
*i bbc.620
      l2=l2+nwds
*i bbc.627
      if (2*(l2/2).eq.l2) l2=l2+1
      l2h=(l2-1)/mult+1
*i bbc.628
c
c     ***for set output, squeeze out unneeded information
      if (iabs(ioutf).ne.2) go to 303
      nholl=1
      ha(ihollh)=hexplod
      lsq=l2
      lsqh=(lsq-1)/mult+1
      l2=l2+(npart+ntype+1)*mult+npart+2*ntype+2
      if (2*(l2/2).eq.l2) l2=l2+1
      l2h=(l2-1)/mult+1
      ilim=npart+ntype+1
      do 301 i=1,ilim
  301 ha(lsqh+i-1)=ha(l1h+i-1)
      ilim=npart+2*ntype
      nex1=l1+(npart+ntype+nmat)*mult
      nex2=lsq+(npart+ntype+1)*mult
      do 302 i=1,ilim
  302 ia(nex2+i-1)=ia(nex1+i-1)
      ia(nex2+ilim)=ia(nex1+ilim)
      ia(nex2+ilim+1)=ia(nex1+ilim+nmat)
  303 continue
*i bbc.630
      if (iabs(iinpf).eq.2.and.iabs(ioutf).eq.2) nmat=nmati
*d up4.70,84
*i bbc.636
c  
c     ***if the input is a set, and if this is not the first mat,
c     ***open the next material and read to material control.
      if (iabs(iinpf).ne.2) go to 306
      if (imm.eq.1) go to 306
      close(iabs(iu))
      nop=0
      if (iinpf.lt.0) nop=6
      lb=index(diri,' ')-1
      write(sin,'(a,a6)') diri(1:lb),hmati(imm)
      call seek(sin,0,iu,nop)
      if (iinpf.lt.0) iu=-iu
      nwds=3*mult+1
      if (iu.gt.0) call reed(iu,1,a(ib),nwds,0)
      if (iu.lt.0) then
         call repoz(iu)
         read(-iu,'(4x,a8,1x,2a8,1x,i6)')
     x    (ia(l2-1+i),i=1,nwds)
      endif
      nw=6
      if (iu.gt.0) call reed(iu,2,a(ib+nwds),nw,0)
      if (iu.lt.0) read(-iu,'(6x,6i6)') (ia(ib+nwds-1+i),i=1,nw)
      nhh=ia(ib+nwds+2)
      nw=nhh*mult
      iholl=ib+nwds+6
      ihollh=(iholl-1)/mult+1
      if (iu.gt.0) call reed(iu,3,a(iholl),nw,0)
      if (iu.lt.0) read(-iu,'(4x/(9a8))') (ha(ihollh-1+i),i=1,nhh)
      ndr=npart+ntype+1
      nir=npart+2*ntype+2
      nw=ndr*mult+nir
      l1=iholl+nw
      if (2*(l1/2).eq.l2) l1=l1+1
      l1h=(l1-1)/mult+1
      if (iu.gt.0) call reed(iu,4,a(l1),nw,0)
      if (iu.lt.0) then
         read(-iu,'(8x,8a8/(9a8))') (ha(l1h-1+i),i=1,ndr)
         read(-iu,'(12i6)') (ia(l1-1+ndr*mult+i),i=1,nir)
      endif
      hmato(imm)=ha(l1h+npart+ntype)
      nsubm(imm)=ia(l1+ndr*mult+npart+2*ntype)
      l2=l1+nw
      ju=4
      do 305 ipart=1,npart
      jgrt(ipart)=l2
      ju=ju+1
      ngr=ia((npart+ntype+1)*mult+l1-1+ipart)
      nw=ngr+1
      if (iu.gt.0) call reed(iu,ju,a(l2),nw,0)
      if (iu.lt.0) read(-iu,'(12x,1p,5e12.5/(6e12.5))')
     x (a(l2-1+i),i=1,nw)
      l2=l2+nw
  305 continue
      if (2*(l2/2).eq.l2) l2=l2+1
      l2h=(l2-1)/mult+1
      irec3=ju
      nmt=1
  306 continue
c
c     ***if the output is a set, write out the header records
c     ***for this material.
      if (iabs(ioutf).ne.2) go to 308
      if (imm.gt.1) close(iabs(nout))
      nop=1
      if (ioutf.lt.0) nop=7
      lb=index(diro,' ')-1
      write(sout,'(a,a6)') diro(1:lb),hmato(imm)
      call seek(sout,0,nout,nop)
      if (ioutf.lt.0) nout=-nout
      lll=last
      if (im.lt.nmat) lll=lmato(im+1)
      length=4+npart+lll-lmato(im)+1
      nwds=3*mult+1
      ia(ib+nwds+2)=nholl
      ia(ib+nwds+3)=1
      ia(ib+nwds+5)=length
      if (nout.gt.0) call rite(nout,1,a(ib),nw,1)
      if (nout.lt.0) write(-nout,'('' 0v '',a8,1h*,2a8,1h*,i6)')
     x (ha(ibh+i-1),i=1,3),ia(ib+3*mult)
      nw=6
      if (nout.gt.0) call rite(nout,2,a(ib+nwds),nw,1)
      if (nout.lt.0) write(-nout,'('' 1d   '',6i6)')
     x (ia(ib+nwds+i-1),i=1,6)
      nw=mult*nholl
      if (nout.gt.0) call rite(nout,3,a(iholl),nw,1)
      if (nout.lt.0) write(-nout,'('' 2d ''/(9a8))') ha(ihollh)
      ndr=npart+ntype+1
      nir=npart+2*ntype+2
      nw=ndr*mult+nir
      if (iabs(iinpf).eq.2) then
         l11=l1
         l11h=l1h
      else
         l11=lsq
         l11h=lsqh
         ha(lsqh+npart+ntype)=hmato(imm)
         ia(lsq+ndr*mult+npart+2*ntype)=nsubo(imm)
      endif
      if (nout.gt.0) call rite(nout,4,a(l11),nw,1)
      if (nout.lt.0) then
         write(-nout,'('' 3d     '',8a8/(9a8))') (ha(l11h+i-1),i=1,ndr)
         write(-nout,'(12i6)') (ia(l11+ndr*mult+i-1),i=1,nir)
      endif
      ireco=4
      do 307 ipart=1,npart
      ngr=ia(ndr*mult+l11-1+ipart)
      nw=ngr+1
      ireco=ireco+1
      jgr=jgrt(ipart)
      if (nout.gt.0) call rite(nout,ireco,a(jgr),nw,1)
      if (nout.lt.0) write(-nout,'('' 4d '',8x,1p,5e12.5/(6e12.5))')
     x (a(jgr-1+i),i=1,nw)
  307 continue
  308 continue
*d bbc.639
      if (irec3.ne.0) then
         nsub=nsubm(imm)
         nwds=mult+1+6*nsub
         irec3=irec3+1
         if (iu.gt.0) call reed(iu,irec3,a(l2),nwds,1)
         if (iu.lt.0) then
            read(-iu,'(4x,a8,1p,e12.5)') ha(l2h),a(l2+mult)
            do 310 i=1,nsub  
            ll=l2+mult+1+6*(i-1) 
            read(-iu,'(1p,2e12.5,4i6)') a(ll),a(ll+1), 
     x       ia(ll+2),ia(ll+3),ia(ll+4),ia(ll+5)  
  310       continue
         endif
      else if (irec2.ne.0) then
*d bbc.667,668
*d bbc.686
  340 if (indxx.gt.0) write(indxx,'(/,'' ------------'',/)')
*d bbc.708
      loc=(npart+ntype+nmt)*mult+npart+l1-1
*d bbc.711
      loc=(npart+ntype+nmt)*mult+l1-1
*d up4.87
      ireco=ireco+1
*d up4.89,bbc.722
      if (irec3.ne.0) then
         irec3=irec3+1
         if (iu.gt.0) call reed(iu,irec3,a(l3),nwds,1)
         if (iu.lt.0) then
            read(-iu,'(8x,8a8/(9a8))') (ha(l3h-1+i),i=1,n1dr)
            read(-iu,'(12i6)') (ia(l3+n1dr*mult-1+i),i=1,nw)
         endif
      else if (irec2.ne.0) then
*d up4.95
      ireco=ireco+1
*d up4.97,bbc.777
      if (irec3.ne.0) then
         irec3=irec3+1
         if (iu.gt.0) call reed(iu,irec3,a(l4),nwds,1)
         if (iu.lt.0) read(-iu,'(12x,1p,5e12.5/(6e12.5))')
     x    (a(l4-1+k),k=1,nwds)
      else if (irec2.ne.0) then
*d up4.103
      ireco=ireco+1
*d up4.107,bbc.838
      if (irec3.ne.0) then
         irec3=irec3+1
         if (iu.gt.0) call reed(iu,irec3,a(l3),nwds,1)
         if (iu.lt.0) then
            read(-iu,'(8x,a8)') ha(l3h)
            read(-iu,'(12i6)') (ia(l3-1+mult+i),i=1,nw)
         endif
      else if (irec2.ne.0) then
*d up4.113
      ireco=ireco+1
*d up4.115,bbc.908
      if (irec3.ne.0) then
         irec3=irec3+1
         if (iu.gt.0) call reed(iu,irec3,a(l4),nwds,1)
         if (iu.lt.0) read(-iu,'(12x,1p,5e12.5/(6e12.5))')
     x    (a(l4-1+k),k=1,nwds)
      else if (irec2.ne.0) then
*d up4.121
      ireco=ireco+1
*d up4.123,bbc.960
      if (irec3.ne.0) then
         irec3=irec3+1
         if (iu.gt.0) call reed(iu,irec3,a(l4),nwdc,1)
         if (iu.lt.0) read(-iu,'(12x,1p,5e12.5/(6e12.5))')
     x    (a(l4-1+k),k=1,nwdc)
      else if (irec2.ne.0) then
*d up4.129
      if (nout.gt.0) call rite(nout,ireco,a(l4),nwdc,0)
*d bbc.983
  570 if (indxx.eq.0) go to 700
*d bbc.996
  590 write(indxx,'(1x,a8,'' sub'',i3,1p,2e12.3,4x,a8)')
*d bbc.1008
  605 write(indxx,'(1x,a8,'' sub'',i3,1p,2e12.3,4x,a8)')
*d bbc.1014
      if (i.eq.1) write(indxx,'(6x,''vectors:  '',8a8)')
*d bbc.1016
      if (i.gt.1) write(indxx,'(16x,8a8)')
*d bbc.1023
      if (i.eq.1) write(indxx,'(6x,''matrices: '',8a8)')
*d bbc.1025
      if (i.gt.1) write(indxx,'(16x,8a8)')
*d bbc.1136
      subroutine seek(hfile,ivers,nref,nop)
*d bbc.1148,1152
      character*(*) hfile
*d bbc.1154,1155
      character mess*60,age*7,fn*11
*d up2.40
*d up2.42
      if (hfile.eq.'change') go to 210
*d bbc.1163,1167
*d bbc.1172,1173
c     ***for read seek option, file must already exist
*d bbc.1178,1179
c     ***find a free unit number
*d bbc.1187,1188
c     ***open the file with the assigned unit number
*d bbc.1196,1197
c     ***error messages
*d bbc.1198
  210 write(mess,10) hfile,nop
*d bbc.1200
  220 write(mess,20) hfile
*d bbc.1202
  230 write(mess,30) hfile
*d bbc.1206,1208
   10 format(17h seek--bad option,3x,a,3x,i2)
   20 format(26h seek--file does not exist,3x,a)
   30 format(25h seek--no units available,3x,a)
*ident up6
*/ 11jul95 -- fix some problems with the use of directories
*d bbc.547,550
*d up5.277,278
*d bbc.553
      if (iabs(iinpf).eq.2.and.iabs(ioutf).eq.2) then
         if (ird(3).eq.1) write(nsyso,'(/'' directory conversion'')')
         if (indxx.gt.0) write(indxx,'(/'' directory conversion'')')
      else if (iabs(iinpf).eq.1.and.iabs(ioutf).eq.2) then
         if (ird(3).eq.1) write(nsyso,'(/'' file explosion'')')
         if (indxx.gt.0) write(indxx,'(/'' file explosion'')')
      else
         if (ird(3).eq.1) write(nsyso,
     x     '(/'' file description''//(2x,9a8))')
     x     (ha(inowh-1+i),i=1,nhh)
         if (indxx.gt.0) write(indxx,
     x     '(/'' file description''//(2x,9a8))')
     x     (ha(inowh-1+i),i=1,nhh)
      endif
*d up5.302
c     ***for explosions, squeeze out unneeded information
*i up5.303
      if (iabs(iinpf).eq.2) go to 303
*i up5.388
      if (iabs(iinpf).eq.2) nholl=nhh
*i bbc.592
      if (iabs(ioutf).eq.2) go to 296
*d bbc.599
  296 nex1=(npart+ntype)*mult+l1-1 
*d up5.411
      if (nout.lt.0) write(-nout,'('' 2d ''/(9a8))') 
     x (ha(ihollh-1+i),i=1,nholl)
      if (ird(3).eq.1) write(nsyso,
     x '(/'' ===============================''//,
     x '' file description''//(2x,9a8))')
     x (ha(ihollh-1+i),i=1,nholl)
      if (indxx.gt.0) write(indxx,
     x '(/'' ===============================''//(2x,9a8))')
     x  (ha(ihollh-1+i),i=1,nholl)
*i up5.428
      if (ird(4).eq.1) write(nsyso,'(/ 
     x  ''   material     name     nsub   length''/ 
     x  ''   --------     ----     ----   ------'')')
      nex1=(npart+ntype)*mult+l11-1
      nex1h=nex1/mult
      nex2=(npart+ntype+1)*mult+npart+2*ntype+l11-1 
      nex3=nex2+1
      if (ird(4).ne.0) write(nsyso,'(i9,7x,a8,i5,i9)')
     x  imm,ha(nex1h+1),ia(nex2+1),length
*/ 17jul95 -- increase number of nuclides allowed
*d up2.4
      parameter (nucs=400,nvec=150)
*ident up7
*/ 11mar96 -- fix some more problems
*d up6.52
      parameter (nucs=400,nvec=300)
*d up5.97
      nmati=nucs*mult
*i up5.98
      nmati=nmati/mult
*d up5.229
     x  (ha(ibbh+ii-1),ii=1,3),ia(ibb+3*mult)
*d bbc.315
     x  (ha(ibh+i-1),i=1,3),ia(ib+3*mult)
*d up5.331
      if (imm.eq.2) close(iabs(nin))
      if (imm.gt.2) close(iabs(iu))
*i up5.338
      ibh=(ib-1)/mult+1
*d up5.343
     x    (ha(ibh+i-1),i=1,3),ia(ib+3*mult)
*i up5.350
      if (2*(iholl/2).eq.iholl) iholl=iholl+1
*ident vers
*/ version update for bbc
*d bbc.6
c     vers. 2.7 (11 mar 96)
*d bbc.130
      data vers/' vers. 2.7 (11 mar 96)'/