*/ */ use *set shift to define different margins for odd and even pages */ in the revised NJOY manual. this is nice for printing, but not so */ nice for online viewing of the pdf file, or ... */ */ ... use *set noshift to center the NJOY manual text on the page. *set shift */ *set noshift */ *ident up1 */ 21mar2013 */ - acefc */ - coding in subroutine first may read a TAB1 function without */ checking if the allocated space is sufficient. revise to */ make sure the minimum necessary space is allocated. *i acefc.225 integer::nwtst,newnw *d acefc.572 if (nsix.gt.0) then call findf(matd,6,0,nendf) isix=0 newnw=0 do while (isix.lt.nsix) isix=isix+1 call contio(nendf,0,0,scr,nb,nw) nk=n1h do ik=1,nk call tab1io(nendf,0,0,scr,nb,nw) law=l2h nwtst=6+2*(nint(scr(5))+nint(scr(6))) if (nwtst.gt.nwscr) then newnw=nwtst endif do while (nb.ne.0) call moreio(nendf,0,0,scr,nb,nw) enddo call skip6(nendf,0,0,scr,law) enddo enddo if (newnw.gt.nwscr) then deallocate(scr) nwscr=newnw allocate(scr(nwscr)) endif call repoz(nendf) call findf(matd,6,0,nendf) endif *ident up1m */ 21mar2013 */ - No NJOY2012 Manual changes are associated with ident up1. *ident up2 */ 06may2013 */ - groupr */ - coding in njoy99.379 to replace use of an expansion for the */ complementary error function with the more accurate SLATEC */ "erfc" routine was implemented incorrectly. */ - we fix that here, plus delete some no longer needed code. */ - thanks to NRG/Petten (Hogenbirk) and LLNL (Mattoon) for */ uncovering this error. *d groupr.10363,groupr.10368 *d groupr.10433,groupr.10434 bot=rp4*(1-erfc(rc))-rc*exp(r4) *d groupr.10440,groupr.10442 top=rl*exp(r3)-rh*exp(r4)-rp4*(erfc(rh)-erfc(rl)) *d groupr.10567,groupr.10585 *d groupr.10618,groupr.10621 fa(1)=1-erfc(abs(aa)) if (aa.lt.zero) fa(1)=-fa(1) fb(1)=1-erfc(abs(bb)) if (bb.lt.zero) fb(1)=-fb(1) *ident up2m */ 06may2013 */ - groupx */ - updates to the GROUPR chapter of the NJOY2012 manual */ consistent with *ident up2's code changes. *d groupx.50 2012.2. *d groupx.4320,groupx.4323 Eqs.~\ref{Eq86} - \ref{Eq115}). The routine uses the SLATEC version of the reduced complementary error function from the NJOY2012 math module. The resulting integral is returned *ident up3 */ 24may2013 */ - mixr */ - need to make a number of variables global. */ - original deficiency reported by Studsvik/Idaho (Wemple). */ - while we're at it, change from hardwired dimension and do loop */ limits to parameter statements. */ - allows for easy future increase on input limits. */ - fix overloading of hollerith and real variables so User file 1 */ comment appears properly in the output file. *i mixr.8 ! global variables integer::ntape integer,parameter::nninmx=10 integer,parameter::nmtmx=20 integer,parameter::nmatmx=nninmx integer,dimension(nninmx)::jtape,nrt,npt,irt,ipt,ip1t,ip2t,nbt,nwt *d mixr.31 ! ... continue for nnin<=nninmx (=10) input units *d mixr.34,mixr.35 ! mtn list of nmt<=nmtmx (=20) mt numbers for ! the output reactions *d mixr.38,mixr.39 ! matn, list of nmat<=nmatmx (=nninmx=10) pairs (matn,wtn) ! wtn of material numbers and associated weighting factors *d mixr.50 ! des description (66 char max) *i mixr.56 integer,parameter::mxlna=300000 *d mixr.59 integer::mtd,je,ne,jend,idis *d mixr.62,mixr.66 character(66)::strng character(4)::str(17) integer,dimension(nninmx)::nin integer,dimension(nmtmx)::mtn integer,dimension(nmatmx)::matn,jscr real(kr),dimension(nmatmx)::wtn real(kr),dimension(mxlna)::a *i mixr.68 equivalence(str(1),des(1)) *d mixr.79 *d mixr.84 do i=1,nninmx *d mixr.87,mixr.88 read(nsysi,*) nout,(nin(i),i=1,nninmx) do i=1,nninmx *d mixr.91 do i=1,nmtmx *d mixr.94,mixr.95 read(nsysi,*) (mtn(i),i=1,nmtmx) do i=1,nmtmx *d mixr.98 do i=1,nmatmx *d mixr.101,mixr.102 read(nsysi,*) (matn(i),wtn(i),i=1,nmatmx) do i=1,nmatmx *d mixr.109 read(strng,'(16a4,a2)') (str(i),i=1,17) *d mixr.372 ! This version will keep track of pointers for up to nninmx units. *d mixr.381 integer::nwtot,nr,np,ip1,ip2,ir,ip,i,ktape,ln *d mixr.384,mixr.385 *ident up3m */ 24may2013 */ - mixx */ - updates to the MIXR chapter of the NJOY2012 manual */ consistent with *ident up3's code changes. *d mixx.48 2012.3. *d mixx.71 ! ... continue for nnin<=nninmx (=10) input units *d mixx.74,mixx.75 ! mtn list of nmt<=nmtmx (=20) mt numbers for ! the output reactions *d mixx.78,mixx.79 ! matn, list of nmat<=nmatmx (=nninmx=10) pairs (matn,wtn) ! wtn, of material numbers and associated weighting factors *d mixx.90 ! des description (66 char max) *d mixx.101 Note that there is a limit of \cword{nninmx}, currently 10, input files. *d mixx.104 The code currently allows up to \cword{nmtmx}, currently 20, *d mixx.279 is initialized for up to \cword{nmtmx} input TAB1 records on up to \cword{nninmx} input tapes *d mixx.297 tables will be found in the subroutine, all with dimension \cword{nninmx}. *ident up4 */ 7jun2013 */ - groupr */ - need to make some local variables global for the flux calculator; */ - need to make some fixed arrays allocatable (fixed size was ok */ when nsigz was restricted to .le. 10). */ - these deficiencies reported by Studsvik/Idaho (Wemple). */ - need global initialization test for panel; *d groupr.24 real(kr)::felo,fehi,sigpot,alpha2,alpha3,beta,sam,gamma *i groupr.87 real(kr),dimension(:),allocatable::falo,fahi integer::ipan *d groupr.171,groupr.172 ! fehi break between computed flux and bondarenko flux ! (must be in the resolved resonance range) *i groupr.359 ipan=0 *d groupr.361 *i groupr.944 if (allocated(falo)) then deallocate(falo) deallocate(fahi) endif *d groupr.3134 read(nsysi,*) fehi,sigpot,nflmax,ninwt,jsigz,& *d groupr.3139 &'' compute flux...fehi, sigpot, nflmax ='',f9.1,f9.2,i8/& *d groupr.3141 fehi,sigpot,nflmax,-ninwt,jsigz *d groupr.3469,groupr.3470 ! The flux is computed between felo (lowest group bound) and ! fehi (must be in resolved range) or until nflmax points *d groupr.3497 real(kr)::e,enext,en,ebot,f1,ej,ejp,f2,f3,f4 *d groupr.3501 real(kr),dimension(:),allocatable::fout *i groupr.3522 nl=lord+1 if (nl.eq.1.and.nsigz.gt.1) nl=2 nfv=1+nl*nsigz+1 allocate(fout(nfv)) *d groupr.3525,groupr.3527 *d groupr.3548,groupr.3550 *d groupr.3558,groupr.3560 felo=egn(1) ebot=felo if (felo.lt.tenth) felo=tenth *d groupr.3581 enext=felo *d groupr.3584 do while (e.lt.fehi.and.ne.lt.nemax) *d groupr.3587 if (e.gt.fehi) e=fehi *d groupr.3599,groupr.3602 fehi=e !--assume nr flux at fehi and above !--calculate contributions below fehi for nr flux *d groupr.3611,groupr.3612 if (e.ge.alpha(k)*fehi) then f1=(1-alpha(k)*fehi/e)*wtf/(1-alpha(k)) *d groupr.3766 &1x,i6,'' points'')') felo,fout(1),net-net1 *i groupr.3816 deallocate(fout) *d groupr.3889 if (e.gt.el*(1-small).and.e.lt.en*(1+small)) go to 230 *d groupr.4050 if (matd.ne.matl.or.mfd.ne.mfl.or.mtd.ne.mtl.or.ipan.eq.0) then ipan=1 *d groupr.4589 *d groupr.4592 save ip *d groupr.4597,groupr.4599 if (allocated(falo)) then deallocate(falo) deallocate(fahi) endif allocate(falo(nfv)) allocate(fahi(nfv)) call finda(1,falo,nfv,nflx,wtbuf,nbuf) call finda(2,fahi,nfv,nflx,wtbuf,nbuf) enext=falo(1) *d groupr.4613,groupr.4614 call finda(ip,falo,nfv,nflx,wtbuf,nbuf) call finda(ip+1,fahi,nfv,nflx,wtbuf,nbuf) *d groupr.4619 do while (e.ge.fahi(1).and.ip.lt.nfp) *d groupr.4621 falo(i)=fahi(i) *d groupr.4624 call finda(ip,fahi,nfv,nflx,wtbuf,nbuf) *d groupr.4634 call terp1(falo(1),falo(l),fahi(1),fahi(l),e,flux(iz,il),2) *d groupr.4637,groupr.4638 call terp1(falo(1),falo(nfv),fahi(1),fahi(nfv),e,xtot,2) enext=fahi(1) *ident up4m */ 7jun2013 */ - groupx */ - updates to the GROUPR chapter of the NJOY2012 manual */ consistent with *ident up4's code changes. *d groupx.836 lower limit of the first group to a specified energy \cword{fehi} or *d groupx.2539,groupx.2540 ! fehi break between computed flux and bondarenko flux ! (must be in resolved resonance range) *d groupx.3031 of parameters given and their values. The parameters \cword{fehi} *d groupx.3546 *d groupx.3728,groupx.3729 A lower energy limit, \cword{felo}, is chosen, and the cross sections are read into storage until a maximum energy, \cword{fehi}, or a *d groupx.3733 is then solved from the break energy down to \cword{felo}. The *d groupx.3736 calculation is finished, fluxes from $10^{-5}$ eV to \cword{felo} are *d groupx.3738 for the Bondarenko option. From \cword{felo} to the energy break point, *ident up5 */ 7aug2013 */ - groupr */ - make unr deallocation conditional (AWE, Cornock) */ - resolve flux calculator issues (Studsvik, Wemple) */ - include additional test in getfwt when searching for e on ninwt */ after 200 continue to overcome possible near duplicate energies */ at the top of the energy mesh; */ - if test revision in up4.68 needs to occur for line groupr.3883; */ - move coding to update el, wl and xl within the 210 continue loop */ to assure correct values are passed to terp1 after 230 continue. *d groupr.892 if (allocated(unr)) deallocate(unr) *i groupr.3529 scr1=0 *i groupr.3563 scr1=0 scr2=0 *i groupr.3823 if (allocated(scr1)) deallocate(scr1) if (allocated(scr2)) deallocate(scr2) *i groupr.3881 if (abs(e-el).lt.el*small.and.en.lt.0) then w=wl xc=xl enext=en go to 250 endif *d groupr.3883 if (e.gt.el*(1-small).and.e.lt.en*(1+small)) go to 230 *i groupr.3886 el=en wl=wn xl=xn *d groupr.3890,groupr.3892 *ident up5m */ 7aug2013 */ - no manual changes *ident up6 */ 8aug2013 */ - purr */ - correct unit number variable used in tab1io and moreio calls */ for urr energy-dependent scattering radius data (Trkov, IJS). *d purr.769 call tab1io(nendf,0,0,arry(inow),nb,nw) *d purr.772 call moreio(nendf,0,0,arry(jj),nb,nw) *ident up6m */ 8aug2013 */ - no manual changes *ident up7 */ 8aug2013 */ - samm */ - need to make a test for possible energy-dependent scattering */ radius more specific (Trkov, IJS). *d samm.271 if (lru.eq.1 .and. lrf.ne.2) call error('s2sammy',& *ident up7m */ 8aug2013 */ - no manual changes *ident up8 */ 8aug2013 */ - groupr */ - make sure we write the last multigroup record to ngout2 even */ when its data are zero, as has always been done in the past */ (issue reported by Martin, Sandia). */ - an improvement in moving from njoy99 to njoy2012 was a */ little too zealous is skipping over groups with zero data. *d groupr.727 if (elo.ge.emaxx.and.ig.ne.ngi) go to 580 *ident up8m */ 8aug2013 */ - no manual changes *ident up9 */ 22aug2013 */ - groupr */ - provide more robust testing for initial and final multigroup number */ in getdis. previous coding could exceed the maximum multigroup and */ produce spurious results (issue reported by Sublet, CCFE). *i groupr.7502 integer::ignow,ngnow,ngn1 *i groupr.7556 ngn1=ngn+1 *i groupr.7589 ngnow=1 ignow=0 *i groupr.7600 if (ng.gt.ngn1) then ng=ngn1 ig=ignow do il=1,nl ff(il,ng)=0 enddo go to 465 endif ngnow=ng *i groupr.7607 if (iglo+ig.gt.ngn1) then ng=ngnow ig=ig-1 go to 465 endif ignow=ig *ident up9m */ 22aug2013 */ - no manual changes *ident up10 */ 3sept2013 */ - gaspr */ - need better checking for allocatable arrays when processing */ files with multiple temperatures (Vanhanen, Aalto U) *i gaspr.474 if (allocated(egas)) then deallocate(egas) deallocate(sgas) endif *ident up10m */ 3sept2013 */ - no manual changes *ident up11 */ 4sept2013 */ - groupr */ - need more storage space for tmp in getsed (Vanhanen, Aalto U). */ - new algorithm starts with a large allocation request and */ tests the allocation status, reducing the array size until */ the request is successful. */ - also tweak identical error message text to make them unique. *i groupr.9901 integer::ier *d groupr.9920,groupr.9921 ier=1 ntmp=100000 do while (ier.ne.0) if (allocated(tmp)) deallocate(tmp) allocate(tmp(ntmp),stat=ier) if (ier.ne.0) then ntmp=ntmp/2 endif enddo *d groupr.9940 'storage for tmp exceeded1',' ') *d groupr.10048 'storage for tmp exceeded2',' ') *ident up11m */ 4sept2013 */ - no manual changes *ident up12 */ 5sept2013 */ - covr */ - need to make sure the array we deallocate was really allocated. */ (Vanhanen, Aalto U). *d covr.462,covr.463 if (allocated(x))deallocate(x) if (allocated(y))deallocate(y) *ident up12m */ 5sept2013 */ - no manual changes *ident up13 */ 19sept2013 */ - errorr */ - increase nwds in covout to match njoy99. */ - increase scr space in colaps to always be at least npage+50. */ - fixes unexplained stop reported by Vanhanen, Aalto U. *d errorr.6900 nwds=10000000 *i errorr.8956 if (nwscr.lt.npage+50) nwscr=npage+50 *ident up13m */ 19sept2013 */ - no manual changes *ident up14 */ 19sept2013 */ - purr */ - increase nsamp to match njoy99. */ - make sure 1 .ge. ibin .ge. nsamp in unrest *i purr.54 ! message flags integer::mflg1,mflg2 *d purr.131 nsamp=10000 *i purr.276 mflg1=0 mflg2=0 *i purr.1727 character(60)::strng *i purr.2189 if (ibin.le.0) then if (mflg1.eq.0) then mflg1=1 write(strng,'(''reset ibin=1, consider larger nsamp'',& &'' or smaller nbin'')') call mess('purr',strng,'') endif ibin=1 endif *i purr.2190 if (ibin.gt.nsamp) then if (mflg2.eq.0) then mflg2=1 write(strng,'(''reset ibin=nsamp,'',& &'' consider smaller nbin'')') call mess('purr',strng,'') endif ibin=nsamp endif *ident up14m */ 19sept2013 */ - correct a typo in the text and related sample output in Section 1; */ - add a new warning message to Section 7. *d purx.101 piece of a PURR output listing shows 16 ladders being processed for *i purx.765 \item[\cword{message from purr---reset ibin=1 (or =nsamp), consider ...}] ~\par The \cword{nbin} size specified is too large for PURR's internal arrays. Either decrease the input \cword{nbin} or increase the PURR's \cword{nsamp} variable. *ident up15 */ 26sept2013 */ - samm */ - there is some confusion in the coding between the maximum */ Legendre order and the number of Legendre orders. This */ change also fixes the message about the maximum Legendre */ order from reconr (rem). *d samm.1415 ncoef=lllmax *ident up15m */ 26sept2013 */ - no manual changes *ident up16 */ 26sept2013 */ - reconr */ - delete coding that closes unit nscrl in rexsx. this unit holds */ elastic scattering (mf4/mt2) data that needs to be accessed if */ the logical variable, "Want_Angular_Dist" is changed to .true. */ - still need to close this unit though ... add coding in reconr */ to do so (ack). *i reconr.145 logical there *i reconr.378 !-- careful, unit number must match nscrl from resxs. inquire(unit=16,exist=there) if (there) call closz(16) *d reconr.2541 *ident up16m */ 26sept2013 */ - no manual changes *ident up17 */ 01oct2013 */ - endf */ - allow more flexibility in findf when searching a gendf tape. *d endf.1544,endf.1545 *ident up17m */ 01oct2013 */ - no manual changes *ident up18 */ 02oct2013 */ - errorr */ - if the user groupr structure extends beyond the range of the */ weight function, then the grpav routine may return with "nan" */ for some cross sections. add coding to (i) warn the user of */ the group structure/weight function mis-match, and (ii) set */ those multigroup cross sections to zero. */ - fixes "nan" issue reported by Vanhanen, Aalto U. */ - indicies used in grpav's scr aren't quite right when the number */ of union groups exceeds npage, we fix them now (ack). *i errorr.38 integer::mwtf *i errorr.452 mwtf=0 *d errorr.8665 integer::ngg=0 *d errorr.8750,errorr.8751 scr(nw+1)=0 nwds=nt+nz+nunion+1+ngg+1 *d errorr.8852 if (ans(1,1,1).ne.zero) then ans(1,1,2)=ans(1,1,2)/ans(1,1,1) else ans(1,1,2)=zero endif *i errorr.10498 !--warn User when the weight function is zero; it most likely means ! the xs energy range extends beyond the weight function energy ! range. if (wtf.eq.zero.and.mwtf.eq.0) then mwtf=1 call mess('egtwtf',& 'xs energy range exceeds weight function range',& 'some multgroup data may be suspect') endif *ident up18m */ 02oct2013 */ - add a new warning message to Section 16. *i errorx.3286 \item[\cword{message from egtwtf---xs energy range exceeds ...}] ~\par The cross section multigroup energy range extends beyond the energy range defined for the weight function. Cross section values in the undefined region will be wrong or \cword{nan}. *ident up19 */ 03oct2013 */ - util */ - delete a couple of redundant lines in closz *d util.229,util.230 *ident up19m */ 03oct2013 */ - no manual changes *ident up20 */ 08oct2013 */ - acer */ - the apparent number of photons can differ for jobs using binary */ tapes versus ascii tapes (Trumbull, KAPL). */ - loss of significant digits when working with ascii tapes makes */ this tricky, particularly when trying to extract the original */ primary photon energy from the sum of primary photon plus */ incident particle energy. This patch works for 1h which has */ a single primary photon over the 20 MeV incident neutron energy */ range while also seeing the two distinct secondary photons of */ 2.112370 MeV and 2.11238 MeV in 50V mt16. */ - NOTE: we strongly recommend use of binary tapes in all njoy */ jobs to maximize the number of significant digits that are */ saved when passing pendf data among the various modules. *d acefc.7846 real(kr),parameter::eps=4.e-6_kr *d acefc.8314 if (r.le.eps) go to 111 *ident up20m */ 08oct2013 */ - no manual changes *ident up21 */ 09oct2013 */ - samm */ - make sure lllmax is defined. needed for array allocation if the */ "Want_Angular_Dist" logical variable is changed from its default */ false value to true. we start with a value believed to always be */ large enough, but after the real, problem dependent, value is */ determined also check that the initial allocation was sufficient. *i samm.31 integer,parameter::lllmaxx=10 *d samm.552 if (nmtres.gt.0) then lllmax=lllmaxx call allo endif *i samm.2078 if (lllmax.gt.lllmaxx) then call error('lmaxxx','need larger lllmaxxx','') endif *ident up21m */ 09oct2013 */ - no manual changes *ident up22 */ 21oct2013 */ - purr */ - need to make sure "init" in unrest is reset to zero when */ executing purr multiple times in the same job, or when */ processing multiple materials (issue reported by Koscheev, */ IPPE). */ - need additional tests to make sure we deallocate all previously */ defined allocatable arrays prior to exiting or prior to reallo- */ cating them with the current nbin, ntemp and nsig0 values. */ - rewind the scratch tape before processing each matd. */ - prior to this last patch, if multiple matd's are processed in */ the same purr job and the ntemp, nsigz and nbin values are the */ same for the first and later matd's it was the first matd's */ data that were retrieved from the scratch tape. *i purr.12 integer::init *i purr.171 init=0 *i purr.173 call repoz(-nscr) *i purr.177 deallocate(sigpl) *i purr.201 if (allocated(tabl)) then deallocate(tabl) deallocate(tval) deallocate(fis) deallocate(cap) deallocate(els) endif *d purr.204,purr.211 if (.not.allocated(er)) allocate(er(nermax)) if (.not.allocated(gnr)) allocate(gnr(nermax)) if (.not.allocated(gfr)) allocate(gfr(nermax)) if (.not.allocated(ggr)) allocate(ggr(nermax)) if (.not.allocated(gxr)) allocate(gxr(nermax)) if (.not.allocated(gt)) allocate(gt(nermax)) if (.not.allocated(es)) allocate(es(nsamp)) if (.not.allocated(xs)) allocate(xs(nsamp)) *d purr.262 if (allocated(heat)) deallocate(heat) allocate(heat(4,nunr,ntemp)) *d purr.344 if (allocated(c)) deallocate(c) allocate(c(nc)) *d purr.346 if (allocated(d)) deallocate(d) allocate(d(nd)) *i purr.634 if (allocated(tabl)) then deallocate(tabl) deallocate(tval) deallocate(er) deallocate(gnr) deallocate(gfr) deallocate(ggr) deallocate(gxr) deallocate(gt) deallocate(es) deallocate(xs) deallocate(fis) deallocate(cap) deallocate(els) endif if (allocated(heat)) deallocate(heat) if (allocated(c)) deallocate(c) if (allocated(d)) deallocate(d) *d purr.1728 *ident up22m */ 21oct2013 */ - no manual changes *ident up23 */ 24oct2013 */ - samm */ - revise per updates in the ORNL SAMRML code. */ - impacts the RML resonance calculations for */ endf/b-vii.1 35Cl (rem). *d samm.1809 ex=abs(eres(ires,ier)-echan(j,ig,ier)) *d samm.3256 *d samm.6355 if (psmall(k,ier).ne.zero) then *d samm.6358,samm.6360 *ident up23m */ 24oct2013 */ - no manual changes *ident up24 */ 18mar2014 */ - acedo */ - fix error message if desired temperature is not found on */ the input tape (Trkov, IAEA); */ - need additional logic to update the xss(lsig...) array if */ multiple sub-sections exist for a specific mf=10/mt (ack). */ - previously the code could crash or, depending upon compiler */ options, run silently to completion. */ - NOTE: If code had run to completion, the resulting ACE */ file will correctly include all sub-sections but */ the standard output will only include the first */ sub-section. */ - increase nmax (the maximum number of mt values that can be */ processed) from 100 to 350. needed when processing selected */ eaf-2010 files. */ - also check if nmax is exceeded; current code runs silently */ to completion but the .##y file contains invalid pointers */ causing an immediate mcnp crash. *d acedo.91 if (math.lt.0)& *d acedo.121 nmax=350 *i acedo.180 if (j.gt.nmax) call error('acedos','too many reactions',& 'need larger nmax') *i acedo.250 if (j.gt.nmax)& call error('acedos','too many reactions',& 'need larger nmax') if (is.ne.ns) xss(lsig-1+j)=l *ident up24m */ 18mar2014 */ - add a new warning message to Section 19. *i acex.2773 \item[\cword{error in acedos***too many reactions, need ...}] ~\par The number of mt values in the ACE output file exceeds acedos's internal limits. Increase the value of \cword{nmax}. *ident up25 */ 07apr2014 */ - errorr */ - we failed to allocate egn for all possible multigroup options */ (reported by Becker, KIT) *i errorr.9985 if(ign.eq.16)allocate(egn(ngn+1)) if(ign.eq.17)allocate(egn(ngn+2)) *i errorr.9999 allocate(egn(ngn+1)) *ident up25m */ 07apr2014 */ - no manual changes *ident up26 */ 07apr2014 */ - groupr */ - cm2lab is running out of space (Orsi, ENEA) */ - an if test in f6cm can be true due to round-off, */ causing epnext to be set to zero and leading to */ an infinite loop in cm2lab. Make the test less */ sensitive. *d groupr.6436 if(epmax*up.lt.xc*e) epn=e*(sqrt(epmax/e)-sqrt(xc))**2 *ident up26m */ 07apr2014 */ - no manual changes *ident up27 */ 08apr2014 */ - purr */ - a simple typo when reading urr data from endf/b-vi 233u */ (the only Adler-Adler format evaluation left, we believe). *d purr.719 call listio(nendf,0,0,a(iscr),nb,nw) *ident up27m */ 08apr2014 */ - no manual changes *ident up28 */ 15apr2014 */ - heatr */ - need a patch in h6cm similar to what we did in groupr's */ f6cm (ack). *d heatr.3363 if(epmax*up.lt.xc*e) epn=e*(sqrt(epmax/e)-sqrt(xc))**2 *ident up28m */ 15apr2014 */ - no manual changes *ident up29 */ 29apr2014 */ - groupr */ - we increased tmp array space in up11 but still need more */ (for jeff-3.2 238u, for example). */ - a difference between njoy2012 and njoy99 is that njoy2012, */ by default (ismooth=1), will expand the low energy portion */ of emission spectra defined in histogram format. we insert */ additional energy points to allow the spectrum to more closely */ follow a sqrt(E) profile. when processing delayed neutron */ spectra (mt=455 only, spectra from other mt values are ok) */ we failed to update a pointer needed to properly define the */ starting location in the tmp array for the now larger TAB1 */ function. */ - both issues reported by wemple/studsvik. */ - we also include additional array bounds tests to assure the */ new TAB1 function fits within the allocated tmp space (ack). *d up11.13 ntmp=250000 *i groupr.9989 if (l1+9+2*mm.gt.ntmp) call error('getsed',& 'storage for tmp exceeded3',' ') *i groupr.10060 if (m1+9+2*mm.gt.ntmp) call error('getsed',& 'storage for tmp exceeded4',' ') *i groupr.10073 m=m1+8+2*mm *ident up29m */ 29apr2014 */ - no manual changes *ident up30 */ 1may2014 */ - groupr */ - when dealing with astrophysics (1.e9 degK) temperatures */ the target nuclide za value was set to zero on the output */ gendf tape. also at these highly elevated temperatures, */ unresolved resonance data, if present, was ignored. */ (Conlin, LANL) *d groupr.472 diff=100000000 *ident up30m */ 1may2014 */ - no manual changes *ident up31 */ 1may2014 */ - acefc */ - need more scratch space in acelcp (ack). *d acefc.8768 integer,parameter::nwscr=500000 *ident up31m */ 1may2014 */ - no manual changes *ident up32 */ 2may2014 */ - groupr */ - the "extending lin-lin as sqrt(E) ..." algorithm in getmf6 */ can produce a zero only emission spectrum under the rare */ condition of an original spectrum defined at two energy */ points, where there is a non-zero probability at zero */ emission energy and zero probability at the maximum allowed */ non-zero energy. subsequently an infinite loop condition */ may occur. */ - we expand the existing "patching low-energy distribution ..." */ algorithm to avoid this issue. (Orsi, ENEA) *d groupr.5822,groupr.5829 if (nn.eq.2.and.lep.eq.2) then j=0 if (tmp(ilo+6+ncyc).lt.tmp(ilo+1)/(awr+1)**2) then j=1 tmp(ilo+7)=0 tmp(ilo+8)=tmp(ilo+1)/(awr+1)**2 tmp(ilo+9)=2/tmp(ilo+8) elseif (tmp(ilo+7).ne.0.and.tmp(ilo+9).eq.0) then j=1 tmp(ilo+9)=tmp(ilo+7) tmp(ilo+7)=0 endif if (j.ne.0) then write(nsyso,'('' patching low-energy distribution at'',& &1p,e10.3)')tmp(ilo+1) endif endif *ident up32m */ 2may2014 */ - no manual changes *ident up33 */ 27jun2014 */ - thermr */ - reduce the delta-temperature tolerance when comparing the user */ requested temperature versus the temperature being read from */ the input tape; allows for creating S(a,b) files on a finer */ temperature grid (ack). */ - a similar change follows in up34 for acefc and aceth. */ ***************************************************************** */ *** NOTE: This tighter tolerance means that test01 with its *** */ *** 300 degK input temperature will fail. We change it *** */ *** to 296 degK to better match the temperature found *** */ *** on the S(a,b) input tape. This will cause changes *** */ *** in the test01 output files. *** */ ***************************************************************** *d thermr.1654 do while (abs(t-temp).gt.temp/500) *ident up33m */ 27jun2014 */ - no manual changes *ident up34 */ 02jul2014 */ - acefc & aceth */ - reduce the delta-temperature tolerance when comparing the user */ requested temperature versus the temperature being read from */ the input tape; allows for creating S(a,b) files on a finer */ temperature grid. */ - these changes made in coordination with up33 (ack). */ - aceth */ - current coding to get nxs(1) in continuous formatted files */ is off by one. a comparison with 99.113, when continuous kernel */ file capability was first introduced, shows a couple of code */ differences which we eliminate now. *d acefc.237 real(kr),parameter::ttol=1 *i aceth.59 real(kr)::delta *i aceth.66 real(kr),parameter::ttol=1 *d aceth.117 delta=ttol do while (delta.ge.ttol) *d aceth.124,aceth.126 delta=abs(temp-tempd) if (delta.ge.ttol) call tomend(nin,0,0,xs) *d aceth.662 len2=len2+itxe-1 *d aceth.664 itce=len2-1 *ident up34m */ 02jul2014 */ - no manual changes *ident up35 */ 05sept2014 */ - unresr */ - eliminate a fixed size array allocation with a calculation */ of the true needed space (issue reported by Orsi, ENEA) *d unresr.178 nb=12+nsigz+nunr*(1+5*nsigz) *ident up35m */ 05sept2014 */ - no manual changes *ident up36 */ 05sept2014 */ - groupr */ - add missing allocation statements in gengpn (issue reported */ by Wemple, Studsvik). */ - need more space in getgyl for some JEFF-3.2 evaluations */ (issue reported by Orsi, ENEA). *i groupr.2689 ngp=ngn+1 allocate(egn(ngp)) *i groupr.2696 ngp=ngn+1 allocate(egn(ngp)) *i groupr.2718 ngp=ngn+1 allocate(egn(ngp)) *i groupr.2725 ngp=ngn+1 allocate(egn(ngp)) *i groupr.2732 ngp=ngn+1 allocate(egn(ngp)) *d groupr.8842 ntmp=99000 *ident up36m */ 05sept2014 */ - no manual changes *ident up37 */ 05sept2014 */ - resxsr */ - fix a couple of njoy99-to-njoy2012 conversion issues */ (reported by Wemple, Studsvik). *d resxsr.411 write(nscr) ha(1),(a(mult+i),i=iscr,iscr+n),ia(nwds-1),ia(nwds) *i resxsr.478 call repoz(-nscr) *d resxsr.498 write(nout)(a(k),k=1,nwds) *ident up37m */ 05sept2014 */ - no manual changes *ident up38 */ 18sept2014 */ - groupr */ - revise argument list passed in displa to be consistent with */ the declared array dimensions (resolves halt in g95 if compiled */ with array bounds checking turned on); */ - NOTE: problems run with an executable produced by the Intel */ Fortran compiler yield the same matricies with or */ without this patch, as the original array allocation */ is correct for the user's problem size. */ - expand the logic in getgyl that checks for constant production */ over low energies to account for histogram interpolation. */ - include logic in getgyl that sets econst to zero when dealing */ with file 13 photon data. *d groupr.750 call displa(ig,prod,nl,nz,jconst,ig2lo,igzero,nlg,ngi) *i groupr.8907 !--if histogram interpolation, start with e equal ! to the second energy point if (nint(tmp(l+7)).eq.1) e=tmp(ll+3) *i groupr.8914 else econst=zero *ident up38m */ 18sept2014 */ - no manual changes *ident up39 */ 18sept2014 */ - acefc */ - coding introduced in up1 to determine the necessary allocation */ for scr when reading file 6 tab1 records is incomplete. this */ modification assures that the largest tab1 size is identified. */ - this issue identified while processing a candidate 235u cielo */ file from ornl (Leal). *d up1.22,up1.24 newnw=max(nwscr,nwtst,newnw) *ident up39m */ 18sept2014 */ - no manual changes *ident up40 */ 14oct2014 */ - reconr */ - correct a message text typo (Koning, Petten). */ - successful execution of the cross section calculation algorithm */ in csunr2 can depend upon failing a "do while" test where we */ expect two real numbers to be equal. due to finite computer */ precision this test can remain true when the comparison is */ false. we revise the test to eliminate this very rare */ false positive condition (Wemple, Studsvik). *d reconr.1902 call mess('lunion',text,'adjusted using jump in xsec') *d reconr.4198 do while (res(i1+6).le.e-small) *ident up40m */ 14oct2014 */ - no manual changes *ident up41 */ 04dec2014 */ - acefc */ - previous coding assumes if an mf3/mt5 section exists, then light */ particle emission spectra will be found in mf6/mt5. */ - if this is not true, pointers in the ace file will be */ incorrect and a subsequent viewr job to plot the ace data */ can enter an infinite write loop (reported by Koning, Petten). */ - we provide coding revisions that define light particle flags */ while processing mt=5 to overcome this deficiency. */ - include an extra contio to up1 coding to read the end-of-section */ record when checking for the laregest tab1 function in mf6. *i up1.29 call contio(nendf,0,0,scr,nb,nw) !read eos record *i acefc.43 integer::mt5n,mt5p,mt5d,mt5t,mt5he3,mt5a *i acefc.312 mt5n=1 !default is no neutron production in mt5 mt5p=1 ! " proton mt5d=1 ! " deuteron mt5t=1 ! " triton mt5he3=1 ! " 3He mt5a=1 ! " alpha *i up1.19 if (mth.eq.5) then !--test for light particle production; 0=yes if (abs(c1h-1).lt.0.0001) mt5n=0 if (abs(c1h-1001).lt.0.0001) mt5p=0 if (abs(c1h-1002).lt.0.0001) mt5d=0 if (abs(c1h-1003).lt.0.0001) mt5t=0 if (abs(c1h-2003).lt.0.0001) mt5he3=0 if (abs(c1h-2004).lt.0.0001) mt5a=0 endif *d acefc.4783 if (mt.ne.1.and.mt.ne.2.and.mt.ne.301.and.& (mt.ne.5.or.(mt.eq.5.and.mt5n.eq.0))) then *d acefc.4801 if (mt.ne.1.and.mt.ne.2.and.& (mt.ne.5.or.(mt.eq.5.and.mt5p.eq.0))) then *d acefc.4822 if (mt.ne.1.and.mt.ne.2.and.& (mt.ne.5.or.(mt.eq.5.and.mt5d.eq.0))) then *d acefc.4839 if (mt.ne.1.and.mt.ne.2.and.& (mt.ne.5.or.(mt.eq.5.and.mt5t.eq.0))) then *d acefc.4856 if (mt.ne.1.and.mt.ne.2.and.& (mt.ne.5.or.(mt.eq.5.and.mt5he3.eq.0))) then *d acefc.4871 if (mt.ne.1.and.mt.ne.2.and.& (mt.ne.5.or.(mt.eq.5.and.mt5a.eq.0))) then *i acefc.5154 if (mt.eq.5.and.mt5n.eq.1) iskip=1 *d acefc.5162 if (mt.eq.2.or.mt.eq.28.or.mt.eq.41.or.& *i acefc.5172 if (mt.eq.5.and.mt5p.eq.0) iskip=0 *d acefc.5175 if (mt.eq.2.or.mt.eq.32.or.mt.eq.35.or.& *i acefc.5181 if (mt.eq.5.and.mt5d.eq.0) iskip=0 *d acefc.5184 if (mt.eq.2.or.mt.eq.33.or.mt.eq.36.or.& *i acefc.5190 if (mt.eq.5.and.mt5t.eq.0) iskip=0 *d acefc.5193 if (mt.eq.2.or.mt.eq.34.or.mt.eq.106.or.& *i acefc.5197 if (mt.eq.5.and.mt5he3.eq.0) iskip=0 *d acefc.5200 if (mt.eq.2.or.(mt.ge.22.and.mt.le.25).or.& *i acefc.5211 if (mt.eq.5.and.mt5a.eq.0) iskip=0 *ident up41m */ 04dec2014 */ - no manual changes *ident up42 */ 05jan2015 */ - acedo */ - mcnp's ace file specification for dosimetry files with multiple */ interpolation ranges says to write the NR NBT values followed */ by the NR INT values but we have always written the NR NBT,INT */ values as pairs. issue identified by Milocco (JET,UK), */ Trkov (IAEA) & Brown (LANL). */ **************************************************************** */ * NOTE: This error has existed in ALL past versions of NJOY * */ **************************************************************** */ * NOTE: All dosimetry files found in the production mcnp_data * */ * 531dos, 532dos and llldos files only contain a single * */ * interpolation interval and therefore are UNAFFECTED * */ * by this error. Also user generated dosimetry files * */ * whose endf source data only contain a single interpo- * */ * lation interval are UNAFFECTED. * */ **************************************************************** *d acedo.162,acedo.163 xss(l+i-1)=scr(5+2*i) xss(l+nr+i-1)=scr(6+2*i) *ident up42m */ 05jan2015 */ - no manual changes *ident up43 */ 08jan2015 - 10feb2015 */ - heatr */ - the variables used when calculating the photon energy "kick" */ are computed in multiple locations. we redefine these as */ global variables and only calculate them once (in nheat). */ - hgam102, introduced to calculated heating when the 1h capture */ data were moved from mf12 to mf6, only included the recoil */ energy. we should have included the photon "kick" to get */ more accurate heating and damage values, particularly at low */ energy, and do so now (issue reported by Konno, JAEA). */ ******************************************************** */ *** NOTE: This error has existed since endf/b-vii.0 *** */ *** files were released, but ONLY for 1h. *** */ ******************************************************** */ */ define emc2, tm and rtm as global variables *i heatr.35 real(kr)::emc2,tm,rtm *i heatr.128 use physics ! provides amassn,amu,ev,clight *i heatr.320 emc2=amassn*amu*clight*clight/ev tm=emc2*(awr+1) rtm=1/tm */ */ delete emc2, tm and rtm local variable definitions from */ nheat, capdam, tabsq6, gheat, tabsqr and disgam *d heatr.900 *d heatr.909 real(kr)::qs,q0,ebar,dame,yld,qsave *d heatr.1016,heatr.1018 *d heatr.1622 *d heatr.1629 real(kr)::e,zx,ax,denom,z,en,aw1fac *d heatr.1642 save zx,ax,denom,z,aw1fac *d heatr.1647,heatr.1651 *d heatr.4010 *d heatr.4016 real(kr)::ein,rein,x,y,xr,awc,xh,yh,xl,yl,dx,s *d heatr.4024,heatr.4025 ein=2*tm *d heatr.4934 *d heatr.4942 real(kr)::afact,aw1fac,z,e,dame *d heatr.4968,heatr.4970 *d heatr.5458 *d heatr.5464 real(kr)::ein,rein,xl,yl,xh,yh,dx,x,y,xr,s *d heatr.5472,heatr.5473 ein=2*tm *d heatr.5519 *d heatr.5523 *d heatr.5525 *d heatr.5528,heatr.5530 return */ end of changes to make emc2, tm and rtm global */ */ revise ebar in hgam102 to include the photon energy "kick" *i heatr.4915 ! internals real(kr)::er,eg2 *d heatr.4917 *d heatr.4922,heatr.4923 !--include recoil energy plus photon "kick" energy er=e/(awr+1) eg2=disc102*disc102*rtm/2 ebar=er+eg2 dame=df(ebar,zp,ap,zt,at) *ident up43m */ 08jan2015 */ - heatx */ - equation 198 contains a 2/3 exponent that should really be 3/2, */ per eqn 2.10 in Lindhard et al, Mat.Fys.Medd.DanFid.Selsk 33, */ no.14 (1963). The NJOY code has always been correct, just a */ typo in this, and the earlier njoy91, manual (reported by Pat */ Griffin, SNL). *d heatx.656 F_L&=&\frac{0.0793Z_R^{2/3}Z_L^{1/2}\left(A_R+A_L\right)^{3/2}} *ident up44 */ 12jan2015 */ - samm */ - reposition an integer declaration statement (mostly a cosmetic */ change as we typically declare integers prior to reals but had */ not done so in this instance; and especially when some of those */ integers appear in subsequent real declaration statements). */ - keeps the Visual Digital Fortran 6.6A compiler happy (per */ Cabellos, NEA). *i samm.85 integer::nmtres,ncoef,nresp,ier *d samm.88 *ident up44m */ 12jan2015 */ - no manual changes *ident up45 */ 12jan2015 */ - acefc */ - even though we now allocate many arrays there are still fixed */ array dimensions that become too small over time. we increase */ a couple of them here to support efforts related to the CIELO */ Project and the IAEA pfns crp (Trkov, IAEA). *d acefc.1830 nt1w=4200 *d up31.6 integer,parameter::nwscr=800000 *ident up45m */ 12jan2015 */ - no manual changes *ident up46 */ 27jan2015 */ - groupr */ - tweak array definition coding in getmf6 so usage is consistent */ with similar coding elsewhere in this routine. */ - revise array specification for p(7) in f6cm to be consistent */ with njoy99. depending upon compiler options, users specifying */ lord>6 in their input may have suffered a silent array overflow */ (both issues reported by Bunde, DOE/Idaho). *d groupr.5861 tmp(ilo+6+ncyc)=sigfig(tmp(ilo+6+ncyc),7,0) *d groupr.6396 *i groupr.6398 real(kr)::p(mxlg) *ident up46m */ 27jan2015 */ - no manual changes *ident up47 */ 29jan2015 */ - heatr */ - we recently noticed that some evaluated nuclear data files */ contain photon production data for a given mt in both mf6 */ and one or more of mf12 through mf15. this causes njoy to */ incorrectly combine the "direct" and "energy-balance" methods */ when calculating heating. we set a flag when reading mf6 */ photon production data so that the corresponding mt in one or */ more of mf12 through mf15 is not processed. */ - an information message identifying the mf/mt section is */ included in njoy's standard output. *i heatr.29 integer::i6p,mt6yp(maxmf6) *i heatr.739 if (nint(zap).eq.0) then i6p=i6p+1 mt6yp(i6p)=mth endif *i heatr.4957 integer::mf6flg character(len=70)::strng1,strng2 *i heatr.5004 ! skip over this mf/mt if photon data were already found in mf6 if (i6p.gt.0) then mf6flg=0 do i=1,i6p if (mt6yp(i).ne.mth) cycle mf6flg=1 exit enddo if (mf6flg.ne.0) then write(strng1,'(''skipping mf'',i2,''/mt = '',i3)')mfh,mth write(strng2,'(''photons were already processed in mf6'')') call mess('gheat ',strng1,strng2) call tosend(nscr,0,0,scr) go to 105 endif endif *ident up47m */ 29jan2015 */ - add a new warning message to Section 11. *i heatx.2632 \item[\cword{message from gheat---skipping ... processed in mf6}] ~\par NJOY has found photon data for a given mt in both mf6 and mf12 - mf15. Only the mf6 data are used. *ident up48 */ 5feb2015 */ - acefc */ - in unionx we open scratch units iold and inew, and leave them */ open for subsequent use in gamsum (where they are closed). if */ there are no photon data, gamsum is not called and these units */ remain open. if a later module tries to open these unit numbers */ we crash. */ - add conditional coding in unionx to make sure these units */ are closed (issue reported by Cabellos, NEA). *i acefc.1767 if (ngmt.eq.0) then !will close these in gamsum when ngmt != 0 call closz(iold) call closz(inew) endif *ident up48m */ 5feb2015 */ - no manual changes *ident up49 */ 10feb2015 */ - errorr */ - an array overflow error was observed when attempting to process */ the tendl-2013 83Kr file (reported by Cabellos, NEA). */ - the issue appears to be a evaluation error as the mf2/mt151 */ urr region data are given for 2 l-states while the mf32/mt151 */ urr region data are given for 3 l-states. njoy utilizes the */ mf2/mt151 l-state value when reading mf32/mt151 and so can't */ properly read this section. */ - we add a test and error stop when encountering this condition. */ - we also allow the mf32 nls be less than mf2, but advise the */ user that these covariance data are incomplete. *i errorr.3076 if (n1h.gt.nls) then call error('resprx',& 'mf2/mf32 l-state mis-match',& 'probable evaluation file error') else if (n1h.lt.nls) then write(strng1,'(''mf2 nls='',i1,'', but mf32 nls='',i1)')& nls, n1h call mess('resprx',strng1,& 'continue with partial urr covariance data') nls=n1h endif *ident up49m */ 10feb2015 */ - add a new error and warning messages to Section 16. *i errorx.3068 \item[\cword{error in resprx***mf2/mf32 l-state mismatch ...}] ~\par The \cword{nls} value for mf32 URR data is larger than that specified in mf2. This is likely an evaluation file error. \item[\cword{message from resprx---mf2 nls=I, but mf32 nls=J ...}] ~\par The \cword{nls} value for mf32 URR data is smaller than that specified in mf2. Processing will continue but covariance data for the complete set of mf2 URR parameters is incomplete. *ident up50 */ 12feb2015 */ - acefc */ - the suite of standard ace plots is sometimes incomplete with some */ emitted neutron angular distribution and secondary neutron spectra */ plots missing (reported by Trkov, IAEA). */ - a global variable used to keep track of the number of neutron */ emitting reactions was erroneously used as a local variable */ for delayed neutron related data processing. this does not */ impact the underlying ace file since we have already written */ out the correct value and associated arrays, but did impact */ the do loop range used to control production of selected ace */ file plots. *d acefc.13184 nrr=nint(xss(l)) *d acefc.13187,acefc.13188 if (nrr.ne.0) then n=2*nrr *d acefc.13207 nrr=nint(xss(l)) *d acefc.13210,acefc.13211 if (nrr.ne.0) then n=2*nrr *d acefc.13239 nrr=nint(xss(l)) *d acefc.13242,acefc.13243 if (nrr.ne.0) then n=2*nrr *d acefc.13258 nrr=nint(xss(l)) *d acefc.13261,acefc.13262 if (nrr.ne.0) then n=2*nrr *ident up50m */ 12feb2015 */ - no manual changes *ident up51 */ 26feb2015 * - groupr */ - correct a typo in the Kalbach-Mann formalism constants (reported */ by Huria, Westinghouse). */ - current coding uses the "k86" parameter variable to skip over */ this no longer used, and obsolete, coding. rather than */ correct the typo we'll delete these code segments. *d groupr.6668,groupr.6671 *d groupr.6673 *d groupr.6750 !--kalbach systematics *d groupr.6774,groupr.6792 ! kalbach-86 (obsolete kalbach-mann coding has been deleted) iza2=nint(zap) aa=bach(izap,iza2,izat,enow,ep) t=aa*(cosh(aa*w)+r*sinh(aa*w))/(2*sinh(aa)) *d groupr.6873,groupr.6876 *d groupr.6878 *d groupr.6914 !--kalbach systematics *d groupr.6918,groupr.6937 ! kalbach-86 (obsolete kalbach-mann coding has been deleted) iza2=nint(zap) aa=bach(izap,iza2,izat,enow,epnext) t=aa*(cosh(aa*w)+r*sinh(aa*w))/(2*sinh(aa)) *ident up51m */ 26feb2015 */ - no manual changes *ident up52 */ 26feb2015 */ - thermr */ - while recasting a do while loop in njoy 99 thermr/iel into a */ more traditional do loop in njoy2012 we omitted a test that */ forces a zero cross section for thermal elastic scattering at */ an energy point just beyond the user emax. */ - when later processed by groupr this yields non-zero values */ in groups beyond the thermal cutpoint. *i thermr.1349 if (iex.eq.ne) ej(nj)=0 *ident up52m */ 26feb2015 */ - no manual changes *ident up53 */ 10mar2015 */ - heatr */ - coding introduced in up47 to test for redundant photon data in */ mf6 and mf12 failed to initialize an array index. jobs that */ process multiple temperatures may suffer an array overflow */ error, depending upon the number of temperatures being processed */ and the number of mf6 sections present in the input file (issue */ reported by Orsi, ENEA). *i heatr.723 i6p=0 *ident up53m */ 10mar2015 */ - no manual changes *ident up54 */ 06apr2015 */ - no code changes *ident up54m */ 06apr2015 */ - matxsx */ - thermal material names given in Table 21 are incomplete */ and/or don't reflect endf/b-vii nomenclature (discovered */ while debugging issues encountered by Kornreich (LANL) */ when attempting to run transx/partisn with matxsr generated */ files). *d matxsx.443 \cword{hh2o} & 222 & H in H$_2$O \\ *d matxsx.445 \cword{poly\textdollar} & 224 & H in polyethylene (CH$_2$) coherent \\ *d matxsx.447 \cword{hzrh\textdollar} & 226 & H in ZrH coherent \\ *d matxsx.449 \cword{dd2o} & 228 & D in D$_2$O \\ *d matxsx.451 \cword{graph\textdollar} & 230 & C in graphite coherent \\ *d matxsx.453 \cword{be\textdollar} & 232 & Be metal coherent \\ *d matxsx.455 \cword{bebeo\textdollar} & 234 & Be in BeO coherent \\ *d matxsx.457 \cword{zrzrh\textdollar} & 236 & Zr in ZrH coherent \\ *d matxsx.459 \cword{obeo\textdollar} & 238 & O in BeO coherent \\ *d matxsx.461 \cword{ouo2\textdollar} & 240 & O in UO$_2$ coherent \\ *d matxsx.463 \cword{uuo2\textdollar} & 242 & U in UO$_2$ coherent \\ *ident up55 */ - 03jun2015 */ - purr */ - the rdf2un routine doesn't properly skip over lrf=7 formatted */ resolved resonance data and so doesn't detect the subsequent */ urr data (seen in preliminary isoW files from ORNL). */ - a similar issue exists in unresr and is fixed in the */ next update. *d purr.718 if (lrf.eq.4.or.lrf.eq.7) then *i purr.729 if (lrf.eq.7) then call listio(nendf,0,0,a(iscr),nb,nw) do while (nb.ne.0) call moreio(nendf,0,0,a(iscr),nb,nw) enddo endif *ident up55m */ - 03jun2015 */ - no manual changes *ident up56 */ - 03jun2015 */ - unresr */ - fix rdunf2 as was done in up55 for purr's rdf2un *d unresr.462 if (lrf.eq.4.or.lrf.eq.7) then *i unresr.473 if (lrf.eq.7) then call listio(nendf,0,0,scr,nb,nw) do while (nb.ne.0) call moreio(nendf,0,0,scr,nb,nw) enddo endif *ident up56m */ - 03jun2015 */ - no manual changes *ident up57 */ - 04jun2015 */ - aceth */ - up34.29 exchanged one typo for another, sigh. this caused */ the thermal ace itce pointer to be wrong and coherent elastic */ data were not properly written to the thermal ace file. a */ subsequent acer check/plot (i.e., iopt=7) job fails with an */ unexpected eof error. issue reported by Zheng (Texas A&M). *d up34.29 itce=len2+1 *ident up57m */ - 04jun2015 */ - no manual changes *ident up58 */ - experimental updated, no longer needed. *ident up59 */ - 22jun2015 */ - groupr */ - level number and isomer number are used interchangably in mf6, */ mf8, mf9 and mf10. specifically, when mf8 points to mf6 we */ are dealing with "isomer number" but when mf8 points to mf9 */ or mf10 we are dealing with "level number". current groupr */ coding does not recognize this difference and if mf8 points */ to mf6 and the level number and isomer number differ we either */ process the wrong data or die with a data not found message */ (issue reported by Cornock, AWE). */ - revised coding attempts to extract the appropriate isomer */ number when auto processing (i.e., user input = 10/) by */ checking if the current 1000*Z+A read in mf8 is the same */ as the previous value. */ - for explicit user input, when requesting Xzzzaaam, treat */ "m" as isomer number for X=2 and treat "m" as a level */ number when X=3 or 4. */ - also, previous coding dealing with mfd>10000000 and lfs was */ inefficient and sometimes redundant. we clean that up now. *i groupr.42 ! - lfs8(i) points to the "level number" from mf8. ! - mlfs8(i) is calculated and corresponds to NJOY's assumption ! of the ground state or isomer number. *d groupr.47 lfs8(maxr2),mlfs8(maxr2) integer::lastza,izatest *d groupr.65 integer::lfs,isom *i groupr.335 integer::itmp *d groupr.587,groupr.589 360 continue lfs=0 isom=0 izam=0 *d groupr.592,groupr.600 call nextr(iauto,matd,mfd,mtdp,scr) *d groupr.644,groupr.651 *d groupr.625,groupr.633 call nextr(iauto,matd,mfd,mtdp,scr) *i groupr.639 ! -- if auto processing, already have level number (lfs) and isomer ! number (isom) from nextr; if user input may need to decode the ! user mfd. then calculate izam if (iauto.eq.0.and.mfd.ge.10000000) then ! -- decode from user mfd input itmp=mfd/10000000 itmp=(mfd-10000000*itmp)/10 lfs=mfd-(10000000*(mfd/10000000)+10*itmp) isom=lfs if (lfs.lt.10) then izam=mod(mfd,10000000) else izam=10*mod(mfd,10000000) endif elseif (iauto.eq.1.and.mfd.ge.10000000) then if (lfs.lt.10) then izam=mod(mfd,10000000)+lfs else izam=10*mod(mfd,10000000)+lfs endif endif *d groupr.768,groupr.772 jzam=izam *d groupr.1045 subroutine nextr(iauto,matd,mfd,mtd,scr) *d groupr.1054 integer::iauto,matd,mfd,mtd *i groupr.1104 isom=mlfs8(ir) *i groupr.1206 isom=mlfs8(ir) *d groupr.1401 imm=isom *d groupr.5231,groupr.5232 if (mfd.eq.12.or.(mfd.ge.30000000.and.mfd.lt.40000000))& call getyld(e,en,idis,yld,matd,mfd,mtd,lfs,nend3) if (mfd.ge.20000000.and.mfd.lt.30000000)& call getyld(e,en,idis,yld,matd,mfd,mtd,isom,nend3) *i groupr.9094 izatest=0 lastza=0 *i groupr.9817 if (izan.ne.lastza) then if (iis.eq.0) then mlfs8(imf10)=0 else mlfs8(imf10)=1 endif else mlfs8(imf10)=mlfs8(imf10-1)+1 endif lastza=izan *ident up59m */ - 22jun2015 */ - no manual changes (yet!) *ident up60 */ - 14jul2015 */ - errorr */ - maxe too small error encountered when processing endf/b-vii.1 */ 58Ni (reported by Bruss, TAMU). */ - a multiplicative factor that should always be greater */ than unity can, in fact, be less than one for very small */ low energy groups. revise the calculation so that this */ factor is greater than one while guaranteeing at least */ one energy point will be sampled within this small group. */ - add a couple of timing statements so the user knows */ we're stilling working. */ - while debugging this issue we noticed the subroutine */ identified by the "maxe too small" error message could be */ incorrect and so fix those messages also. *i errorr.4034 real(kr)::time *i errorr.4418 call timer(time) write(strng1,'("resonance parameter loop done",13x,f8.1,"s")')time call mess('rpxlc12',strng1,'') *i errorr.4445 call timer(time) write(strng1,'("sensitivity calculation continues",9x,f8.1,"s")')time call mess('rpxlc12',strng1,'') *i errorr.4469 call timer(time) write(strng1,'("sensitivity calculation completed",9x,f8.1,"s")')time call mess('rpxlc12',strng1,'') *d errorr.4763 if (ii.gt.maxe) call error('rpxunr',& *d errorr.4892 if (ii.gt.maxe) call error('rpendf',& *d errorr.10068 if (ewmin.lt.1.05e0_kr) then eskip4=1.0e0_kr+0.5e0_kr*(ewmin-1.0e0_kr) endif *ident up60m */ - 14jul2015 */ - correct the subroutine name associated with the number of pointwise */ xsec ... message. *d errorx.3138 \item[\cword{error in rpendf***number of pointwise xsec of res exceede...}]~\par *ident up61 */ - 21aug2015 */ - plotr */ - need more space in plotr. */ - use parameter statements for arrays for easy future */ upgrade. */ - make the several "storage exceeded" error messages unique */ to better understand where this failure originates. *d plotr.387,plotr.396 integer,parameter::mmax=20000 !same in plotr and viewr integer,parameter::nwamax=45000 integer,parameter::maxaa=200000 real(kr),dimension(nwamax)::a real(kr),dimension(maxaa)::aa real(kr),dimension(mmax)::x,y,b,dxm,dxp,dym,dyp equivalence (x(1),aa(1)),(y(1),aa(mmax+1)),(b(1),aa(2*mmax+1)) equivalence (dxm(1),aa(3*mmax+1)),(dxp(1),aa(4*mmax+1)) equivalence (dym(1),aa(5*mmax+1)),(dyp(1),aa(6*mmax+1)) *d plotr.1204 thin=(eht-elt)/(mmax-500) *d plotr.1206 thin=ten**(log10(eht/elt)/(mmax-500)) *d plotr.1324 if (n.gt.mmax) call error('plotr','storage exceeded1',' ') *d plotr.1568 call error('plotr','storage exceeded2',' ') *d plotr.1579 call error('plotr','storage exceeded3',' ') *ident up61m */ - 21aug2015 */ - no manual changes *ident up62 */ - 21aug2015 */ - viewr */ - keep array sizes consistent with those in plotr (up61) *d viewr.342,viewr.347 *d viewr.349 integer,parameter::mmax=20000 !same in plotr and viewr integer,parameter::maxaa=200000 real(kr),dimension(15)::z real(kr),dimension(maxaa)::aa real(kr),dimension(mmax)::x,y,b,dxm,dxp,dym,dyp equivalence (x(1),aa(1)),(y(1),aa(mmax+1)),(b(1),aa(2*mmax+1)) equivalence (dxm(1),aa(3*mmax+1)),(dxp(1),aa(4*mmax+1)) equivalence (dym(1),aa(5*mmax+1)),(dyp(1),aa(6*mmax+1)) *ident up62m */ - 21aug2015 */ - no manual changes *ident up63 */ 06sep2015 */ - mixr */ - add lrp=-1 flag in mf1/mt451 to show no mf2. */ - add awi, emax and nsub in mf1/mt451 if a version 6 file */ (missing data reported by Simakov, IAEA). */ - awi comes from the first input file; */ - emax is the largest value from the multiple input files; */ - nsub depends upon awi. */ - default is nsub=10 (incident nuetron), but recognize the */ possibility of incident photon, proton, deuteron, triton, */ 3he or alpha. *i up3.32 integer,parameter::lrp=-1 integer::nsub *i mixr.61 real(kr)::awi,emax *i mixr.134 awi=1 emax=20.e6_kr nsub=10 *d mixr.154 if (iverf.gt.5) then call contio(nin(i),0,0,a(iscr),nb,nw) if (a(iscr+1).gt.emax) emax=a(iscr+1) if (i.eq.1) then awi=a(iscr) if (awi.lt.0.1) nsub=0 if (awi.gt.0.9980.and.awi.lt.0.9990) nsub=10010 if (awi.gt.1.9950.and.awi.lt.1.9970) nsub=10020 if (awi.gt.2.9895.and.awi.lt.2.9897) nsub=10030 if (awi.gt.2.9890.and.awi.lt.2.9891) nsub=20030 if (awi.gt.3.9670.and.awi.lt.3.9680) nsub=20040 endif endif *d mixr.179 a(iscr+2)=lrp *d mixr.195,mixr.196 a(iscr)=awi a(iscr+1)=emax *d mixr.199 a(iscr+4)=nsub *ident up63m */ 06sep2015 */ - no manual changes *ident up64 */ 09nov2015 */ - heatr */ - coding introduced in up53 to make sure the i6p variable, introduced in */ up47, is initialized sits within an if statement that may not always be */ executed if processing multiple materials. move it to a more general */ location (and for good measure make sure we initialize the mt6yp array). */ - issue noted (and a solution offered (thank you!) by Cabellos (NEA)). *i heatr.716 i6p=0 mt6yp=0 *d up53.11 *ident up64m */ 09nov2015 */ - no manual changes *ident up65 */ 15aug2016 */ - heatr */ - array index over- or under-flow issues in h6ddx. */ - insert an additional array index test to prevent this. can occur */ when the "ep" value passed to this function is outside the energy */ range of the underlying mf6/mt secondary emission data. */ - note, coding in groupr that performs similar calculations is */ laid out differently and does not seem to suffer from the array */ index issue seen here; hence no update is planned for that module. */ - make some arrays larger. */ - delete the local "izat" variable from h6ddx since its already defined */ as a global variable, but reposition where we define it in nheat to */ make sure its defined when we need it. *d heatr.944 nwmax=250000 *d heatr.946 na=500000 *i heatr.1002 izat=nint(zat) *d heatr.1197 *d heatr.3561 integer::ndnow,npnow,ncnow,mnow,inow,lnow,nl,na,l,lll *d heatr.3574 save efirst,enow,nl,inow,mnow,lnow,ncnow,na,illdef *d heatr.3578 *i heatr.3610 if (lnow.le.ncnow) go to 200 *ident up65m */ 15aug2016 */ - no manual changes *ident up66 */ 17aug2016 */ - acecm */ - tighten the criteria for angular distribution reconstruction; */ - make some fixed arrays allocatable to eliminate the chance of */ a silent array overflow error. */ - acephn */ - correction to a tab1 nbt pointer value. */ - these changes are in response to concerns raised by Trkov (IAEA). *d acecm.233,acecm.234 real(kr),parameter::tol1=0.0002e0_kr real(kr),parameter::tol2=0.002e0_kr *d acecm.241 if (nord+1.gt.ipmax) then write(strng,'(''nord='',i3,'' > ipmax='',i3,'', in mt '',i3)')& nord,ipmax,mth call error('ptleg2',strng,'see ipmax') endif *d acecm.385 real(kr),allocatable::amu(:),pmu(:) *i acecm.389 allocate(amu(np)) allocate(pmu(np)) *i acecm.407 deallocate(amu) deallocate(pmu) *d acepn.948 scr(lld+6)=nn *ident up66m */ 17aug2016 */ - acex */ - the error message modified in up66 was never in the manual; */ so let's put it there now. *i acex.2566 \item[\cword{error in ptleg2***nord= ...}] ~\par The maximum Legendre order for the identified MT reaction exceeds \cword{ipmax}. This is likely an ENDF file error. *ident up67 */ 17aug2016 */ - broadr */ - broadr can seg fault if the user specifies a thnmx value */ greater than the maximum energy in the input file. insert */ a check and make a graceful exit. */ - when there are no RR parameters (lru=0 or 2), restrict */ broadening to no more than 1 MeV regardless of the file's */ EH value. cross sections are already smooth at these energies */ and there is no technical benefit to Doppler broadening. Also, */ Trkov (IAEA) reports possible issues in select files when */ attempting to broaden to higher energies. *i broadr.141 integer::lrf,lrp,lru *i broadr.147 real(kr)::emax *d broadr.230 !--search input endf tape for some parameters ... ! - maximum file energy, emax. ! - total nu-bar (mf1/mt452). ! - resonance flag, lru (from mf2/mt151). *i broadr.233 !--read input file emax and make sure thnmx is legal emax=20.e6_kr !assumed maximum energy call contio(nendf,0,0,scr,nb,nw) !first record lrp=l1h call contio(nendf,0,0,scr,nb,nw) !second record if (n1h.eq.0.and.n2h.ne.0) then call contio(nendf,0,0,scr,nb,nw) if (c2h.gt.zero) emax=c2h endif if (abs(thnmx).ge.0.9999*emax) call error('broadr',& 'max. energy is too large for this input file','') !--read input file nu-bar, if present *i broadr.264 !--read the (lru) resonance flag lrf=0 if (lrp.eq.0) then lru=0 else if (mfh.le.1) then if (mfh.eq. 1) call tofend(nendf,0,0,scr) call contio(nendf,0,0,scr,nb,nw) endif if (mfh.eq.2) then call contio(nendf,0,0,scr,nb,nw) call contio(nendf,0,0,scr,nb,nw) lru=l1h lrf=l2h endif endif *ident up67m */ 17aug2016 */ - broadx */ - insert this new error message into the manual *i broadx.777 \item[\cword{error in broadr***max. energy too large ...}] ~\par The user requested Doppler broadening to an energy beyond the maximum energy in the ENDF file. *ident up68 */ 17aug2016 */ - rpxlc2 */ - the mpid array values are dependent upon the RR formalism */ (actually a long-standing error initially reported by */ Trkov when still at the Jozef Stefan institute, but */ never corrected). */ - this update covers slbw, mlbw and rm plus an error */ message saying the other formalisms aren't treated (yet!). *d errorr.4511 integer,dimension(6)::mpid integer,dimension(6),parameter::mpidbw=(/1,4,5,6,0,0/) integer,dimension(6),parameter::mpidrm=(/1,3,4,5,6,0/) *i errorr.4519 if (lrf.eq.1.or.lrf.eq.2) then mpid=mpidbw elseif (lrf.eq.3) then mpid=mpidrm else write(strng2,'(''not ready for lrf='',i1,'', lcomp=2'')')lrf call error('rpxlc2',strng2,'') endif *ident up68m */ 17aug2016 */ - errorx */ - insert this new error message into the manual *i errorx.3128 \item[\cword{error in rpxlc2***not ready for lrf= ...}]~\par Coding for this lrf/lcomp=2 combination has not yet been implemented. *ident up69 */ 18aug2016 */ - groupr */ - the dimension limit of 3 in getmf6 for iyss, izss and jjss means */ we're assuming no more than a ground state plus two isomers for */ a given ZA. Recent TENDL files may exceed this limit (issue */ reported by Sublet, CCFE). *d groupr.5671 integer,parameter::nssm=9 integer,dimension(nssm)::iyss,izss,jjss integer,dimension(maxss)::jloss *d groupr.6046 if (nss.gt.nssm) call error('getmf6',& *ident up69m */ 18aug2016 */ - no manual changes *ident up70 */ 18aug2016 */ - purr */ - legacy coding assumes the upper urr limit will not exceed 1 MeV; */ this assumption is no longer valid so let's increase that limit */ to 5 MeV (issue noted by Haeck (IRSN) and Trkov (IAEA)). *d purr.676 real(kr),parameter::etop=5.e6_kr *ident up70m */ 18aug2016 */ - no manual changes *ident up71 */ 18aug2016 */ - plotr */ - a format change, the addition of a tab1 record, in tsl mf6 */ energy distribution data between njoy99/thermr and */ njoy2012/thermr wasn't accounted for in njoy2012/plotr */ (issue reported by Cabellos, NEA). */ - we add the missing call in plotr's ed3d routine now. */ - but note this is only needed when processing files produced */ by njoy2012/thermr. if a legacy njoy99 or earlier file is */ being processed, this patch will fail. */ - fix some long-standing (but harmless) typos in if-tests that */ should only cover the mt=221 to mt=250 range associated with */ tsl files (ack). *d plotr.1380 if (mfd.eq.6.and.mtd.ge.221.and.mtd.le.250) go to 2520 *i plotr.2038 !--this tab1io call should be commented out in the unlikely ! event that an njoy99/thermr, or earlier, file is being processed. if (mfd.eq.6.and.mtd.ge.221.and.mtd.le.250) & call tab1io(nin,0,0,a,nb,nw) ! *d plotr.2051 if (mth.lt.221.or.mth.gt.250) then *d plotr.2808 if (mth.lt.221.or.mth.gt.250) then *ident up71m */ 18aug2016 */ - no manual changes *ident up72 */ 20aug2016 */ - acefc */ - we add "za" and "suff" to calculate the mcnp zaid, but if "za" */ has accidently picked up a small decimal component during */ creation of the original endf-formatted file, say for 235u */ we have 92235.01 rather than 92235.00, we won't get what we */ want. switch to using the integer za in acelod to avoid */ this error (ack). *d acefc.4723 zaid=iza+suff *ident up72m */ 20aug2016 */ - no manual changes *ident up73 */ 22sept2016 */ - errorr */ - sdev and cov array allocation in rpxsamm is insufficient for */ lrf=7, lcomp=2. issue noted while debugging a Leal 16O CIELO */ candidate file. *d errorr.3248,errorr.3249 if (lrf.ne.7.or.lcomp.ne.2) then allocate(sdev(nresp)) allocate(cov(nresp,nresp)) else allocate(sdev(2*nresp)) allocate(cov(2*nresp,2*nresp)) endif *ident up73m */ 22sept2016 */ - no manual changes *ident up74 */ 22sept2016 */ - errorr */ - we failed to notice mt limit tests embedded in errorj when */ importing that code back into njoy several years ago were */ not up to date. */ - mt values in the 875 to 890 range are legal, and used by */ the JEFF community. */ - issue noted by Kodeli (Jozef Stefan Institute, IJS) and */ reported by Cabellos at the Spring, 2016 JEFF meeting). *d errorr.720,errorr.721 if (mt.eq.850.or.(mt.gt.870.and.mt.lt.875).or.mt.gt.891) then write(strng,'(''ignoring unknown mt = '',i5)')mt call mess('errorr',strng,'') cycle endif if (mt.gt.850.and.mt.le.870) go to 121 *d errorr.728 *ident up74m */ 22sept2016 */ - no manual changes *ident up75 */ 15dec2016 */ - broadr */ - Re-think the logic for determining the upper energy limit for */ Doppler broadening. Too many new evaluations now have threshold */ reactions within the resolved resonance energy range and too */ often legacy default choice is not what the end expects or */ wants. */ - change logic so that if user input is thnmax=0 this means */ Doppler broadening will occur to the top of the RRR. If this */ or any other user choice causes threshold reactions to be */ broadened we know the Q-value and will zero out any spurious */ non-zero cross sections below the reaction threshold. */ - remaining options related to thnmax are unchanged. */ - caution ... up67 in this file differs from that provided to */ selected users in pre-release versions of this */ update file. *i broadr.19 real(kr),dimension(ntt)::qmtr,emtr *d broadr.71,broadr.72 ! thnmax max.energy for broadening and thinning ! (default = 0, but see comments below) *d broadr.108,broadr.127 ! Beginning with NJOY2012.75, if the default thnmax ! value is used (default thnmax = 0): ! - (i) and there is a resolved resonance region we ! Doppler broaden to the top of that region. any ! threshold reactions below this upper limit are also ! broadened, but any non-zero cross section for energies ! below the reaction threshold are zeroed. ! - (ii) and there is no resolved resonance region but ! there is an unresolved resonance region we Doppler ! broaden to the beginning of the urr. ! - (iii) and there are no resolved or unresolved ! resonance parameters, we broaden to the lessor of ! 6.5 MeV or the first threshold energy. ! ! As before, a negative value for thnmax forces the ! Doppler broadening upper limit to be abs(thnmax) ! irrespective of the other conditions. ! ! Caution: The magnitude of thnmax must be chosen to ! keep the number of broadenable reactions less than or ! equal to the maximum of ntt (160). *i up67.14 integer::n,npp,itmp *i broadr.148 integer,dimension(:),allocatable::nppmt *i broadr.159 real(kr),parameter::e6pt5=6.5e6_kr *d broadr.197 thnmx=e6pt5 *i up67.37 npp=0 *i up67.49 !--make a list of the lrf7 mt's if (lru.eq.1.and.lrf.eq.7) then call contio(nendf,0,0,scr,nb,nw) call listio(nendf,0,0,scr,nb,nw) npp=l1h if (allocated(nppmt)) deallocate(nppmt) allocate(nppmt(npp)) do i=1,npp nppmt(i)=nint(scr(16+12*(i-1))) enddo !--sort the nppmt list into ascending order if (npp.ge.2) then do i=1,npp-1 do j=i+1,npp if (nppmt(j).lt.nppmt(i)) then itmp=nppmt(i) nppmt(i)=nppmt(j) nppmt(j)=itmp endif enddo enddo endif endif *d broadr.339 *i broadr.342 if (lrp.eq.0) then write(nsyso,'(/'' non-resonance nuclide, input pendf limit'',5x,& &''= '',1pe14.5,'' eV.'')')eresh elseif (lrp.eq.1.and.lru.eq.1) then write(nsyso,'(/'' resolved resonance range upper limit'',9x,& &''= '',1pe14.5,'' eV.'')')eresh elseif (lrp.eq.1.and.lru.eq.2) then write(nsyso,'(/'' unresolved resonance range lower limit'',7x,& &''= '',1pe14.5,'' eV.'')')eresh endif if (eresh.gt.e6pt5) then eresh=e6pt5 write(nsyso,'('' - reset to '',1pe14.5,'' eV.'')')e6pt5 endif if (thnmx.eq.0) then thnmax=eresh elseif (thnmx.gt.0) then thnmax=min(thnmx,eresh) endif if (lrp.eq.1) emin=eresh *i broadr.405 n=1 *i broadr.421 if (n.le.npp.and.mth.eq.nppmt(n)) then n=n+1 goto 170 endif *d broadr.423 if (lrp.eq.1.and.enext.lt.eresh) go to 170 if (lrp.eq.0) then if (fact*enext.lt.thnmax) thnmax=fact*enext endif *i broadr.459 if (thnmax.eq.zero.and.thnmx.eq.0) thnmax=e6pt5 if (allocated(nppmt)) deallocate(nppmt) *d broadr.462,broadr.463 &'' final maximum energy for broadening/thinning = '',1pe14.5,& &'' eV'')')thnmax *i broadr.483 !--get q-values and lab system threshold energy ! for the mt's to be broadened. call repoz(nscr1) do i=1,nreac call findf(mat1,3,mtr(i),nscr1) call contio(nscr1,0,0,scr,nb,nw) call contio(nscr1,0,0,scr,nb,nw) qmtr(i)=scr(2) if (qmtr(i).eq.0) then emtr(i)=0 else emtr(i)=-qmtr(i)*(awr+1)/awr endif enddo *i broadr.1157 real(kr)::tt1old *i broadr.1186 tt1old=zero *d broadr.1296 if (tt(1).gt.emtr(i).and.tt1old.ge.emtr(i)) then tt(1+i)=ss(i,is) else tt(1+i)=0 endif *i broadr.1297 tt1old=tt(1) *ident up75m */ 15dec2016 */ - manual changes to describe the revised Doppler */ broadening logic. *d broadx.416,broadx.440 significant Doppler effects. Until recently the upper energy limit for Doppler broadening was the smallest of (i) the input value \cword{thnmax}, (ii) the upper limit of the resolved-resonance energy range, (iii) the lowest threshold, or (iv) 1.0 MeV (the default input value for \cword{thnmax}). No Doppler broadening or energy-grid reconstruction is performed above that energy. In the past, and what users typically expect as the default action, the second condition often set the Doppler broadening upper limit. However recent evaluated files have increasingly included threshold reactions at energies within the resolved resonance energy range. For example, recent JENDL evaluations for $^{235}$U include a resolved-resonance range upper limit of 2.25 keV, but also include non-zero cross sections for an inelastic level with a 77 eV threshold. Under the rules itemized above, Doppler broadening of these data stops at 77 eV. Other evaluations ({\it e.g.}, ENDF/B-VI, ENDF/B-VII and JEFF-3.1) share the same resolved-resonance range data but have zeroed out this inelastic cross section from 77 eV to 2.25 keV and so Doppler broadening of these files occurs throughout the resolved-resonance range, as most users expect. Zeroing out non-zero data is a cludge from the past and so we have changed the Doppler upper energy limit logic so that the top of the resolved resonance range is now the default condition. This means that non-threshold reactions are also Doppler broadened. The mathematics of this operation can produce non-zero cross sections at energies below the reaction threshold. If this occurs those cross sections are zeroed. As noted in the BROADR module source code comments, users may specify a negative value for \cword{thnmax} to override these selection rules and force Doppler broadening to an upper energy of \cword{abs(thnmax)} eV. This has been a long-term NJOY feature that remains unchanged. *d broadx.659,broadx.660 ! thnmax max.energy for broadening and thinning ! (default = 0, but see comments below) *d broadx.696,broadx.716 ! thnmax A possible upper limit for broadening and thinning. ! Beginning with NJOY2012.75, if the default thnmax ! value is used (default thnmax = 0): ! - (i) and there is a resolved resonance region we ! Doppler broaden to the top of that region. any ! threshold reactions below this upper limit are also ! broadened, but any non-zero cross section for energies ! below the reaction threshold are zeroed. ! - (ii) and there is no resolved resonance region but ! there is an unresolved resonance region we Doppler ! broaden to the beginning of the urr. ! - (iii) and there are no resolved or unresolved ! resonance parameters, we broaden to the lessor of ! 6.5 MeV or the first threshold energy. ! ! As before, a negative value for thnmax forces the ! Doppler broadening upper limit to be abs(thnmax) ! irrespective of the other conditions. ! ! Caution: The magnitude of thnmax must be chosen to ! keep the number of broadenable reactions less than or ! equal to the maximum of ntt (160). *ident up76 */ 15dec2016 */ - samm */ - an ORNL patch to SAMRML that we include here to remain consistent */ with their coding. this will reduce the chances of calling the */ coulx routine which can be unstable under certain combinations of */ rho and eta, hence possibly impacting calculation of charged */ particle reaction cross sections. *d samm.3776 if (rho.lt.1.02e0_kr) then *ident up76m */ 15dec2016 */ - no manual changes *ident up77 */ 16dec2016 */ - this update was actually created in nov2015 while at the IAEA but */ was overlooked during the transition from my LANL "LOFT" computer. */ - we insert it into the mainstream update sequence now ... */ - 13nov2015 */ reconr */ - reconr currently writes the user "tempr" input to the output */ pendf, but this variable is almost always zero. if the input */ tape has already been broadened to a non-zero value this */ information is lost. */ - revise reconr to copy the non-zero input endf temperature */ to the output pendf if tempr is zero. */ - speciality files, such as dosimetry, may only contain redundant */ file 3 reaction data. reconr gets confused when there is no */ file 3 data to be found after the redundant sections are removed. */ - insert upnea119 patch from Andrej Trkov (IAEA) to overcome */ this. */ - issue was discovered when attempting to process IRDFF */ v1.xx 109Ag. *i reconr.13 real(kr)::tempi *i reconr.217 tempi=0 *i reconr.257 if (iverf.ge.6) tempi=scr(1) *i reconr.5007 if (tempr.eq.0) scr(1)=tempi */ *** begin upnea119 *** *i reconr.5034 nxcc=nxc if (nint(zain).eq.1.and.no3.eq.0) nxcc=nxcc-1 scr(6)=nxcc+nmtr+i152 *d reconr.5044,5045 *d reconr.5112 nw=nxcc+nmtr+i152 *d reconr.5174 !--test mfl=0 (occurs when all mf3 data are redundant and removed) if (nint(zain).eq.1.and.(mfl.eq.0.or.mfl.gt.3)) then *i reconr.5197 !--if no other mf3 sections on scratch, copy the rest if(mfl.eq.0) go to 272 *i reconr.5307 272 continue *ident up77m */ 16dec2016 */ - no manual changes *ident up78 */ 16dec2016 */ - thermr */ - up78 (thermr), up79 (aceth) and up80 (leapr) are a suite of */ changes recommended by Damian (CAB) and Roubtsov (CNL) */ primarily for processing revised light and heavy water */ thermal kernels, but are ok to apply to other data sets. */ most thermr changes are related to carrying more precision */ (changes in sigfig calls) in calcem, plus a slight revision */ to the egrid array. we also use the ngrid parameter to set */ the egrid (and other) array size. we also revise the write */ format when iprint=2 to provide more digits and to appear */ similar in form as written by acer. *d thermr.31 integer,parameter::nwscr=500000 *i thermr.1498 character(len=60)::strng *d thermr.1510 integer,parameter::ngrid=118 integer,parameter::nlmax=65 *d thermr.1516,thermr.1517 real(kr)::ubar(ngrid) real(kr)::u2,u2last,u3,u3last,p2(ngrid),p3(ngrid),p(4) *d thermr.1521,thermr.1522 real(kr),dimension(ngrid),parameter::egrid=(/& *d thermr.1542 7.00e0_kr,7.65e0_kr,8.40e0_kr,9.15e0_kr,9.85e0_kr,10.00e0_kr/) real(kr),parameter::unity=1.0e0_kr *d thermr.1545 real(kr),parameter::tolmin=5.e-7_kr *d thermr.1556 integer,parameter::nlpmx=10 *d thermr.1874 enow=sigfig(enow,8,0) *d thermr.1907 ep=sigfig(enow,8,-1) *d thermr.1909 ep=sigfig(ep,8,0) *d thermr.1918 ep=sigfig(enow,8,+1) *d thermr.1921 ep=sigfig(ep,8,0) *d thermr.1928 ep=sigfig(ep,8,0) *d thermr.1947 xm=sigfig(xm,8,0) *d thermr.1996 scr(1+jscr)=sigfig(y(1,i),9,0) *d thermr.1998 scr(1+jscr)=sigfig(y(1,i),8,0) *d thermr.2001 scr(il+jscr)=sigfig(y(il,i),9,0) if (scr(il+jscr).gt.unity) then !--only warn for big miss, but always fix the overflow ! use this same unity+0.0005 value in aceth if (scr(il+jscr).gt.unity+0.0005_kr) then write(strng,'("1cos=",f7.4,", set to 1.& & enow,e''=",2(1pe12.5))')& scr(il+jscr),enow,scr(jscr) call mess('calcem',strng,'') endif scr(il+jscr)=unity endif if (scr(il+jscr).lt.-unity) then !--only warn for big miss, but always fix the underflow if (scr(il+jscr).lt.-(unity+0.0005_kr)) then write(strng,'("1cos=",f7.4,", set to -1.& & enow,e''=",2(1pe12.5),i3)')& scr(il+jscr),enow,scr(jscr) call mess('calcem',strng,'') endif scr(il+jscr)=-unity endif *d thermr.2047 xsi(ie)=sigfig(xsi(ie),9,0) *d thermr.2051 scr(1+jscr)=sigfig(y(1,i),9,0) *d thermr.2053 scr(1+jscr)=sigfig(y(1,i),8,0) *d thermr.2056 scr(il+jscr)=sigfig(y(il,i),9,0) if (scr(il+jscr).gt.unity) then !--only warn for big miss, but always fix the overflow if (scr(il+jscr).gt.unity+0.0005_kr) then write(strng,'("2cos",f7.4,", set to 1.& & enow,e''=",2(1pe12.5))')& scr(il+jscr),enow,scr(jscr) call mess('calcem',strng,'') endif scr(il+jscr)=unity endif if (scr(il+jscr).lt.-unity) then !--only warn for big miss, but always fix the underflow if (scr(il+jscr).lt.-(unity+0.0005_kr)) then write(strng,'("2cos",f7.4,", set to -1.& & enow,e''=",2(1pe12.5),i3)')& scr(il+jscr),enow,scr(jscr) call mess('calcem',strng,'') endif scr(il+jscr)=-unity endif *d thermr.2062,thermr.2067 p2(ie)=p2(ie)/xsi(ie) p3(ie)=p3(ie)/xsi(ie) write(nsyso,'(/,1x,"incident energy =",1pe13.6,& & 5x,"cross section =",1pe13.6,& & 5x,"mubar,p2,p3 =",3(1pe12.4))')& enow,xsi(ie),ubar(ie),p2(ie),p3(ie) write(nsyso,'(/,5x,"exit energy",11x,"pdf",7x,"cosines")') write(nsyso,'( 3x,"---------------",5x,"-----------",2x,88("-"))') *d thermr.2070,thermr.2073 write(nsyso,'(2x,1pe15.8,5x,1pe12.5,0p,8f11.6)')& (scr(ll+ii),ii=1,nlp) if (nl1.gt.nlp) write(nsyso,'(34x,8f11.6)')& (scr(ll+ii),ii=nlp1,nl1) *d thermr.2149 enow=sigfig(enow,8,0) *d thermr.2170 xm=sigfig(xm,7,0) *d thermr.2210,thermr.2220 ubar(ie)=half*ubar(ie)/sum if (iprint.eq.2) then write(nsyso,'(/i5,'' enow '',1p,e13.6,'' xsec '',e13.6,& &'' mubar '',e13.6)') ie,enow,xsi(ie),ubar(ie) write(nsyso,'('' num of mu '', i5)') nmu write(nsyso,'(/'' mu theta dsigma/dmu'')') do i=1,nmu write(nsyso,'(i5,1x,f15.8,1x,f12.4,1x,1p,e14.7)') i,uj(i),& acos(uj(i))*180.0/3.14159265359,sj(i)/2.0 enddo endif *d thermr.2245,thermr.2248 if (iprint.eq.2) then write(nsyso,'(/'' mu = '',f15.8)') u write(nsyso,'('' (e-prime, pdf); num of e-prime '', i5)') nep write(nsyso,*) !--test yu()/sum below: is this pdf normalized to 1.0 ? write(nsyso,'(1p,3(1x,e14.7,1x,e14.7,1x))')& (yu(2*i+1),yu(2*i+2)/sum,i=1,nep) endif *d thermr.2527 real(kr)::p(nlin) *d thermr.2559 x(2)=sigfig(x(2),8,0) *d thermr.2570 xm=sigfig(xm,8,0) *d thermr.2619 x(2)=sigfig(x(2),8,0) *d thermr.2630 xm=sigfig(xm,8,0) *d thermr.2775 x(1)=sigfig(x(1),8,0) *d thermr.2776 if (x(1).eq.e) x(1)=sigfig(e,8,-1) *d thermr.2791 x(1)=sigfig(x(1),8,0) *d thermr.2800 xm=sigfig(xm,8,0) *d thermr.2865 integer,parameter::nwscr=500000 *ident up78m */ 16dec2016 */ - no manual changes *ident up79 */ 16dec2016 */ - aceth */ - up78 (thermr), up79 (aceth) and up80 (leapr) are a suite of */ changes recommended by Damian (CAB) and Roubtsov (CNL) */ primarily for processing revised light and heavy water */ thermal kernels, but are ok to apply to other data sets. */ most thermr changes are related to carrying more precision */ (changes in sigfig calls) in calcem, plus a slight revision */ to the egrid array. we also use the ngrid parameter to set */ the egrid (and other) array size. we also revise the write */ format when iprint=2 to provide more digits and to appear */ similar in form as written by acer. *d aceth.26 integer,parameter::nxss=9000000 *d aceth.81 ninmax=500000 *d aceth.96 nwscr=500000 *d aceth.440,aceth.441 if (abs(xn-xhi).lt.eps) then six(k+loc)=scr(k+isn) else if (abs(xn-xlo).lt.eps) then six(k+loc)=scr(k+isl) else six(k+loc)=scr(k+isl)+& (scr(k+isn)-scr(k+isl))*(xn-xlo)/(xhi-xlo) endif ! if ((six(k+loc).lt.-1.0e0_kr).or.(six(k+loc).gt.1.0e0_kr)) then ! write(nsyso,'(/'' ---warning from acesix---'','' cosine '',f12.8,& ! &'' outside [-1,1] range for e= '',1p,e13.6,& ! &'', bin_mu= '',i4)') six(k+loc),e,k ! endif if (iwt.eq.2.and.six(k+loc).lt.-1.0e0_kr) then six(k+loc) = -1.0e0_kr ! write(nsyso,'('' ---cosine set to -1.0---'')') endif if (iwt.eq.2.and.six(k+loc).gt.1.0e0_kr) then six(k+loc) = 1.0e0_kr ! write(nsyso,'('' ---cosine set to 1.0---'')') endif *d aceth.631 nwscr=500000 *d aceth.833,aceth.857 write(nsyso,'(/6x,''incident energy = '',1p,e13.6,8x,& &''cross section = '',e13.6)') xss(itie+i),xss(itie+ne+i) write(nsyso,'(5x,'' num of e-prime '',i5)') nbini if (ifeng.le.1) then write(nsyso,'(/& &9x,''exit energy'',5x,''cosines''/9x,''-----------'',& &4x,8(''------------''))') else write(nsyso,'(/& &9x,''exit energy'',8x,''pdf'',11x,''cdf'',10x,''cosines''/& &9x,''-----------'',4x,''-----------'',& &3x,''------------'',4x,8(''------------''))') endif lines=lines+4 do j=1,nbini if (ifeng.le.1) then write(nsyso,'(7x,1p,e13.6,1x,0p,8f12.6)')& (xss(k+loc),k=1,lim) if (nang.gt.8) write(nsyso,'(21x,8f12.6)')& (xss(loc+k),k=lim1,nang+1) else write(nsyso,'(7x,1p,e13.6,e15.6,e15.6,1x,0p,8f12.6)')& (xss(k+loc),k=1,lim) if (nang.gt.8) write(nsyso,'(51x,8f12.6)')& (xss(loc+k),k=lim1,nang+3) endif *d aceth.967 use mainio ! provides nsyso use util ! provides openz *i aceth.1222 ! if ((xss(loc+3+k).lt.-1.0e0_kr).or.& ! (xss(loc+3+k).gt.1.0e0_kr)) then ! write(nsyso,'(/'' ---warning from tplots---'', & ! &'' cosine '',f12.8,'' outside [-1,1] range'')')& ! xss(loc+3+k) ! endif *i aceth.1485 ebar=ebar/sum *d aceth.1681,aceth.1682 xmin=1/scale/100 xmax=10/scale *ident up79m */ 16dec2016 */ - no manual changes *ident up80 */ 16dec2016 */ - leapr */ - up78 (thermr), up79 (aceth) and up80 (leapr) are a suite of */ changes recommended by Damian (CAB) and Roubtsov (CNL) */ primarily for processing revised light and heavy water */ thermal kernels, but are ok to apply to other data sets. */ most thermr changes are related to carrying more precision */ (changes in sigfig calls) in calcem, plus a slight revision */ to the egrid array. we also use the ngrid parameter to set */ the egrid (and other) array size. we also revise the write */ format when iprint=2 to provide more digits and to appear */ similar in form as written by acer. *d leapr.445 integer,dimension(1000)::maxt *d leapr.676 & '' effective temp = '',f10.3/& *i leapr.678 write(nsyso,'('' factor_ph = '',f10.6)') tbar *d leapr.834 ndmax=max(nbeta,1000000) *d leapr.954 write(nsyso,'(/'' new effective temp = '',f10.3)') tempf(itemp) */ --- */ --- function terps (leapr) */ --- if be/delta > 2**31 - 1 = 2,147,483,647 and */ --- if i is integer = integer(kind=4) and int(x) = int(x,4), */ --- the result (the value of i) can be negative (on MS Win, with g95); */ --- we suggest using -i8 flag with g95 (for all *.f90); Intel: /4I8 (Win) -i8 (Lin); */ --- (or one can re-write with integer(kind=8) and use int(x,8) for i); */ --- here is a by-pass (in terms of coding). */ --- *i leapr.1093 terps=0 *i leapr.1094 if (i.lt.0) return *d leapr.1114 *d leapr.1596 & '' new effective temp = '',f10.3/& *i leapr.1598 write(nsyso,'('' discr.-oscill. part of eff. temp = '',f10.3)') tsave */ --- */ --- smin in leapr : */ --- smin = 1.0e-75_kr (orig. in NJ12) <-> 2.0e-38_kr (orig. in NJ99) */ --- note that 1.e-75_kr may not work well for all E_in in all S(a,b) models ; */ --- to reproduce CAB evaluations of 2015 (H2O, D2O) w. NJOY2012_up50: */ --- use smin=2.0e-38_kr in the line below */ --- *d leapr.2935 real(kr),parameter::smin=2.0e-38_kr *ident up80m */ 16dec2016 */ - no manual changes *ident up81 */ 22jan2017 */ - acefc, aceth, acedo, acepa, acepn */ - when writing the xsdir stub make sure we leave a space prior */ to the len2 variable. the "i8" field used up until now has */ always included a space if the ace file length is less than */ 100M but a recent pre-endf/b-viii.0 beta file was larger. *d acefc.12574 '(a10,f12.6,'' filename route'',i2,i4,1x,i9,2i6,1p,e10.3,& *d acefc.12578 '(a10,f12.6,'' filename route'',i2,i4,1x,i9,2i6,1p,e10.3)')& *d acefc.12584 '(a13,f12.6,'' file route'',i2,i4,1x,i9,2i6,1p,e10.3,& *d acefc.12588 '(a13,f12.6,'' file route'',i2,i4,1x,i9,2i6,1p,e10.3)')& *d aceth.2140 '(a10,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d aceth.2144 '(a13,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d acedo.585 '(a10,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d acedo.589 '(a13,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d acepa.1005 '(a10,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d acepa.1009 '(a13,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d acepn.2519 '(a10,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *d acepn.2523 '(a13,f12.6,'' filename route'',i2,'' 1 '',i9,2i6,1p,e10.3)')& *ident up81m */ 22jan2017 */ - no manual changes *ident up82 */ 22jan2017 */ - reconr */ - we fail to properly set the lssf flag for the case of energy- */ dependent unresolved resonance fission widths. this results */ in double counting of cross sections in the urr. */ - the lssf flag has been defined properly for the case of */ energy-independent urr widths or when all urr widths are */ energy-independent. */ - thanks to Andrej Trkov (IAEA) for discovering this long- */ standing error. */ - we note that the coding in the unresr and purr modules does not */ suffer from this error. *i reconr.1342 lssf=l1h *ident up82m */ 22jan2017 */ - no manual changes *ident newv */ 22jan2017 */ - njoy, vers and locale */ - update version info */ - update organization and machine/compiler info *d njoy.6 ! Version 2012.82 *d vers.7,vers.8 character(8),public::vers='2012.82' character(8),public::vday='20jan17' *d locale.15,locale.16 character(8),public::lab='lanl t2' character(8),public::mx='pc-ifort' *ident nwvM */ 22jan2017 */ - NJOY2012 Manual title page and document ID update *d njoy12.42 \fancyhead[R]{LA-UR-12-27079 Rev} % *d njoy12.173 \fancyhead[RO,LE]{LA-UR-12-27079 Rev} *d njoy12.76,njoy12.78 \\ \\ Original Issue: December 20, 2012\\ \\ \\ Updated for NJOY2012.82 \\} \date{January 22, 2017}