*/
*/ OECD/NEA compilation of NJOY updates
*/ compatible with the official patch distribution up364
*/
*/ The patches include those carried-over from the set compatible
*/ with the official up259 but not adopted in up364.
*/
*ident upnea001
*/ njoy - C. Broeders, 6-Oct-2006
*/        Open scratch files in local disc area
*/        Ref.: Comments by D.E. Cullen in PrePro-2004 (Scratcha.f) on p.19 of:
*/        "http://www-nds.iaea.org/ndspub/endf/prepro/DOCUMENT/PDF/Overview.pdf"
*/        Status "scratch" does not work with Lahey compiler on Linux,
*/        therefore 'age" is set "unknown"
*d njoy.470
         age='unknown'
*d njoy.471
         write(fn,'(a,i2.2)') 'temp',nun
         open(nun,file=fn,form=for,status=age)  
*/
*ident upnea004
*/ groupr - C. Broeders, 6-Oct-2006
*/          extend IWT=5 spectrum definition up to 200MeV
*/ -------------------------------------------
*d groupr.2145
      dimension w1(92),w2(92),w3(10)
*d groupr.2150
      data w1/0d0,0d0,0d0,0d0,1.d0,93.d0,93.d0,5.d0,
*i groupr.2175
      data w3/3.d7,1.0318d-10,5.d7,6.1908d-11,1.d8,3.0954d-11,
     &1.5d8,2.0636d-11,2.d8,1.5477d-11/
*d groupr.2358
      iw=194
*i groupr.2365
      do i=1,10
         a(i+183+iwght)=w3(i)
      enddo
*/
*/ *ident upnea019 is included in up265
*/
*/ *ident upnea020 is included in up235
*/
*/ *ident upnea021 is included in up261
*/
*/ *ident upnea022 is included in up260
*/
*/ *ident upnea023 is included in up272
*/
*/ *ident upnea024 is included in up273
*/
*/ *ident upnea025 is included in up315
*/
*/ *ident upnea026 is included in up316
*/
*/ *ident upnea027 is included mostly in up317, except a few statements
*/                 which are placed in upnea068
*/
*/ *ident upnea028 is included in up318
*/
*/ *ident upnea029 is included in up316
*/
*/ *ident upnea030 is included in up272
*/
*/ *ident upnea031 is included in up289
*/
*ident upnea032
*/ acer     A. Trkov, 30 May 2008
*/          Plots of discrete inelastic make sense below 10 MeV
*d acer.19586
c                       limit discrete inelastic plots to 10 MeV
                        if (x.gt.xmax) xmax=min(x,10.)
*/
*/ *ident upnea033 included in up278
*/
*/ *ident upnea034 included in up277
*/
*/ *ident upnea035 included in up279
*/
*/ *ident upnea036 included in up279
*/
*/ *ident upnea037 included in up277
*/
*ident upnea038
*/ covr    A. Trkov, 20 October 2008
*          Fix diagnostic message
*d covr.1793,1805
      zero=0
      if (abs(crit).gt.zero) write(strng,                                                      covr.1794 
     &      '(''i'',i3,'' j'',i3,'' xa(i,j)='',1p,e12.4,'' xa(j,i)='',
     &     1p,e12.4)') i,im1,xa(im1ind,i),xa(iind,im1)
      if (abs(crit).gt.test .and. abs(xa(im1ind,i)).gt.1e-20) then                                          covr.1793 
         call error('press','matrix not symmetric',strng)
      endif
      test=1
      test=test/1000000
      if (abs(crit).lt.test) go to 250
      call mess('press','matrix not symmetric',strng)
*/
*/ *ident upnea039 included in up272
*/
*ident upnea040
*/
*/ GROUPR - R. Perry, 15 October 2008
*/          (Original update name: upwe6)
*/          Problem with thermal scattering matricies in GROUPR            
*/          There were small discrepancies between the sums thermal scatter
*/          matrices and the group cross-sections. This update renormalises
*/          the interpolated spectra (produced during integration)
*/          to sum to unity.
*/          (guarding against array overflow added by A. Trkov)
*i groupr.6915
      integer nsi
      parameter (mxnsi=15000)
*i groupr.6922
      dimension sint(2,mxnsi)
*i groupr.7030
      nsi = 0
*i groupr.7146
c
c store interpolated function. 
c
      nsi = nsi+1
      if(nsi.gt.mxnsi)
     &   call error('getaed','mxnsi array limit exceeded',' ')
      sint(1,nsi) = ei
      sint(2,nsi) = fi(1)
*i groupr.7155
c
c sum interpolated spectrum and adjust aed. 
c
      sisum = 0.0
      do il = 1, nsi - 1
        sisum = sisum + (sint(2,il)+sint(2,il+1))*
     &                                  (sint(1,il+1)-sint(1,il))/2
      enddo
c
c don't re-normalise if scatter source above top energy group. 
c
      if(i .lt. ngn .or. (k1 .eq. nlo .and. k2 .eq. nhi) ) then 
        do il = 1, i
          aed(1,il) = aed(1,il)/sisum
        enddo
      endif
*/
*/ *ident upnea041 included in up282
*/
*/ *ident upnea042 is not included; it is redefined in upnea069
*/
*/ *ident upnea043 included in up282
*/
*/ *ident upnea044 included in up273
*/
*/ *ident upnea045 included in up282
*/
*/ *ident upnea046 withdrawn
*/
*/ *ident upnea047 included in up287
*/
*/ *ident upnea048 included in up329 and extended
*/
*/ *ident upnea049 is included in up290
*/
*/ *ident upnea050 is included in up289
*/
*/ *ident upnea051 is included in up363
*/
*/ *ident upnea052 is included in up361
*/
*/ *ident upnea053 is included in up307
*/
*ident upnea054
*/ errorr D.L. Aldama, July 2009
*/        Fix weighting function option
*d errorj.660
      if (iwt.eq.1.or.iwt.eq.4.or.iwt.eq.5.or.
     &     (iwt.ge.7.and.iwt.lt.11))
*d errorj.1492
      if (iwt.eq.1.or.iwt.eq.4.or.iwt.eq.5.or.
     &     (iwt.ge.7.and.iwt.lt.11))
*/
*/ *ident upnea055 is included in up314
*/
*/ *ident upnea056 is included in up312
*/
*/ *ident upnea057 is included in up305
*/
*/ *ident upnea058 is included in up318
*/
*/ *ident upnea059 is included in up205
*/
*/ *ident upnea060 is not needed due to alternative coding in up329
*/
*/ *ident upnea061 is superseeded by upnea068
*/
*/ *ident upnea062 is included in up324
*/
*/ *ident upnea063 is dealt with differently in upnea315
*/
*ident upnea064
*/ acer    A. Trkov, February 2010
*/         Particle emission spectra in the acer plots are corrupted
*/         for MF6 Law 1 LANG 1 when more than one interpolation range
*/         is specified for the distributions on incident particle
*/         energies. In some cases the MCNP calculations are also wrong.
*/         A fix is done when writing the data to a temporary file.
*/         The multiple ranges are suppressed. The first interpolation
*/         law is prescribed over the entire incident energy range
*/         and a message is printed.
*/         WARNING:
*/         This is a temporary patch before a proper solution is found.
*/         The true error probably occurs somewhere near acer.6651
*/         or later, and/or possibly in MCNP.
*/         Implications:
*/         JENDL-HE files truncated to 150 MeV (as proposed for FENDL-3)
*/         led to strongly discrepant results in a benchmark model
*/         calculation representative of the ITER device. The discrepancy
*/         is greatly reduced with the use of this patch. The assumption
*/         in the patch has no influence on the evaluated data because
*/         the interpolation law changes above 20 MeV where the yield
*/         drops to zero due to the reaction representation in MT5.
*d acer.2373,2374
                  call tab2io(nin,0,0,b,nb,nw)
                  nr=n1h
                  ne=nint(b(6))
                  if(nr.gt.1) then
                    write(string,'(a,i3)')
     &                   'multiple interp. ranges for mf6, mt',mt
                    call mess('topfil',string
     &                    ,'first law applied everywhere')
                    nr=1
                    b(5)=nr
                    b(7)=ne
                  end if
                  call tab2io(0,nout,0,b,nb,nw)
*/
*/ *ident upnea065 included in up341
*/
*/ *ident upnea066 is included in up342
*/
*/ *ident upnea067 is included in up363
*/
*ident upnea068
*/ acer    A. Trkov, January 2010
*/         (Revision of upnea061, noticed by Skip Kahler)
*d acer.119,120
c     *               7   read fast ace files to print or edit         *
c     *               8   read thermal ace files to print or edit      *
c     *               9   read dosimetry ace files to print or edit    *
*d acer.407
      else if (iopt.eq.6.or.iopt.gt.9) then
*d acer.435  
      else if (iopt.ge.7.and.iopt.le.9) then
*i acer.17639
c
c     ***read type 3 ace format file
      else if (itype.eq.3) then
         if (mcnpx.eq.0) then
           read(nin) hz(1:10),aw0,tz,hd,hko,hm,(izo(i),awo(i),i=1,16),
     &       (nxs(i),i=1,16),(jxs(i),i=1,32)
         else
           read(nin) hz(1:13),aw0,tz,hd,hko,hm,(izo(i),awo(i),i=1,16),
     &       (nxs(i),i=1,16),(jxs(i),i=1,32)
         endif
         len2=nxs(1)
         n=(len2+ner-1)/ner
         l=0
         do i=1,n
            max=len2-l
            if (max.gt.ner) max=ner
            read (nin) (xss(l+j),j=1,max)
            l=l+max
         enddo
         call closz(-nin)
c        flag incident particle "undefined"
         izai=-1
         awi =-1
*/ 
*/ *ident upnea069 is included in up362
*/ 
*/ *ident upnea070 is included in up363
*/ 
*/ *ident upnea071 is included in up363
*/
*ident upnea073
*/ acer    A. Trkov, January 2011
*/         Error message lenth exceeds string size
*d up360.91,93
                           write(strng,'(''mtd='',i3,'' mt='',i6,
     &                       '' ie='',i4,i5,'' nd='',3i4,'' ed='',
     &                       1p,e9.3e1)')
*/
*ident upnea074
*/ acer    A. Trkov, June 2011
*/         zaid is re-defined incorrectly when editing fast ace files if original
*/         suffix is greater than 0.50
*d acer.17652
         iza=int(zaid+0.001)
*/
*ident upnea075
*/ errorr  A. Trkov, June 2011
*/         One more case to skip input if there are no data to process
*i up324.105
         if(iwt.eq.4) read(nsysi,*) eb,tb,ec,tc
*/
*ident upnea076
*/
*/ HEATR  - K. Vignitchouk, 06/09/11 
*/          Calculate mean neutron energy for law 12-energy
*/          dependent fission neutron spectrum (madland-nix)
*/          (originaly submitted as upwd20)
*/
*i heatr.2169
c
c     ***law 12--energy dependent fission neutron spectrum (madland-nix)
      else if (lf.eq.12) then
          s=((a(lnext)+a(lnext+1))/2)+(4*theta/3)

*/