*/
*/ 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)
*/