*ident up228
*/ viewr -- 6jul07
*/ initialize backgr in tagit prior to calling poly2 (not an
*/ issue if the compiler initializes undefined variables to zero).
*i viewr.1224
      backgr=zero
*ident up229
*/ thermr -- 9jul07
*/ need more space when printing (Broeders, upfzk12).
*d thermr.1614  
     &     f8.3,'' ev.'')') tmax
*d thermr.1620  
     &     f8.3,'' ev.'')') tmax
*ident up230
*/ groupr -- 9jul07
*/ need to define ehi to go with the already defined elo.
*/ ehi has previously been undefined (and likely set to zero
*/ by the compiler).
*i groupr.4819
       ehi=zero
*i groupr.4892
             if (c(l+1).gt.ehi) ehi=c(l+1)
*i groupr.4987
             if (c(l+1).gt.ehi) ehi=c(l+1)
*/ fix incorrect initialization.
*d groupr.5067
      ir=1
*/ add missing save, similar to what was done in up135 for heatr.
*b groupr.5589
      save enow
*ident up231
*/ gaminr -- 9jul07
*/ need to save some variables (similar to up131 in groupr).
*i gaminr.866
      save ng1,ig1
*ident up232
*/ plotr -- 9jul07
*/ make sure law is initialized (not an issue if the compiler
*/ presets undefined integers to zero).
*i plotr.1175
      law=zero
*ident up233
*/ errorr -- 10jul07
*/ restructure this if test since nmd and/or nmt1d might only
*/ be defined when isd.eq.1 is true.
*d errorr.1992
      if (isd.eq.1)then
          if (nmd.ge.nmt1d) go to 390
      endif
*ident up234
*/ acer -- 10jul07
*/ need to initialize lt and lr flags to zero when dealing with
*/ charged particle files (not an issue if the compiler presets
*/ undefined integers to zero).
*i acer.1751
         lt=0
         lr=0
*/ initialize all isotropic angular distribution flag (not an
*/ issue if the compiler presets undefined integers to zero).
*i acer.5341
            iso=0
*ident up235
*/ njoy -- 17jul07
*/ revise if tests introduced in up180 to avoid machine
*/ roundoff errors (up180 sometimes makes 1.000000+5 print
*/ as 10.000000+5)
*i up180.8
      onem=9.99999999d-1
*i up180.10
      onem=9.99999999e-1
*d njoy.1337 
      if (abs(x).lt.onem) go to 140
*d up180.21,23
      if (f.gt.onem.and.hx(10:11).eq.'00')write(hx,'(f9.6,a,i1)')f,s,n
      if (f.gt.tenth.and.f.lt.onem.and.hx(11:11).eq.'0')
     &    write(hx,'(1pf9.6,a,i1)')f,s,n
*ident up236
*/ ccccr -- 17jul07
*/ upgrade dldata to handle a variable number of delayed neutron
*/ groups, up to a maximum of ndmax.  endf/b files typically have
*/ 6 delayed groups, modern jeff files typically have 8.  also,
*/ warn user if too much data are found or if delayed data were
*/ requested but not found on the input tape.
*i ccccr.132
      common/delay/iso,nfam
*d ccccr.208
         if (lprint.eq.1.and.iso.ne.0)call pdlyxs(ndlay)
*d ccccr.3049
c     (there are typically nisod*ndg families, where ndg is the
c     number of delayed neutron groups for this isotope).
*i ccccr.3067
      parameter (ndmax=8)
*d ccccr.3069
      dimension fract(ndmax)
*/ read mf5, mt455 from the groupr tape to get the number of
*/ delayed neutron groups for this isotope.
*i ccccr.3072
      external contio
*d ccccr.3074,3076
c
c     *** get the number of delayed neutron groups for this nuclide
c         from groupr's mf5, mt455 head record.
      call repoz(nin)
      call tpidio(nin,0,0,e(1),nb,nw)
      do while (mf.lt.5)
         call contio(nin,0,0,e(1),nb,nw)
      enddo
      if (mt.eq.455) then
         ndg=nint(e(3))
      elseif (mt.lt.455) then
         do while (mf.eq.5.and.mt.lt.455)
            call contio(nin,0,0,e(1),nb,nw)
         enddo
         if (mf.eq.5)then
            ndg=nint(e(3))
         else
            iso=0
            return
         endif
      else
         iso=0
         return
      endif
      if (ndg.eq.0) then
          iso=0
          return
      elseif (ndg.gt.ndmax) then
          call mess ('dldata','too many delayed neutron groups',
     &               'dlayxs request ignored')
          iso=0
          return
      endif
c
c     *** assign storage (depends on number of delayed groups)
      nfam=ndg*nisod
*d ccccr.3166,3168
      do i=1,ndg
         ifam=ndg*(iso-1)+i
         loca=l8+ngn-ig+ngn*(ifam-1)+ndg*(iso-1)
*d ccccr.3184
      ifam=ndg*(iso-1)-1+l2
*d ccccr.3190
         ifam=ndg*(iso-1)+i
*d ccccr.3201,3202
         ifam=i+ndg*(iso-1)
         loca=l8+ngn+ngn*(ifam-1)+ndg*(iso-1)
*d ccccr.3204 
         locb=l8-1+ndg*ngn*iso+ndg*(iso-1)+i