*/ */ OECD/NEA compilation of NJOY updates */ compatible with the official patch distribution up249 */ *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 */ groupr A. Trkov, 24 July 2007 */ For backward compatibility change error stop to a warning message *d up167.22,23 if (sl.lt.zero.or.sn.lt.zero) call mess('getunr', & ' negative cross sections found - check unresr',' ') */ */ *ident upnea020 is included in up235 */ *ident upnea021 */ groupr A. Trkov 30 Oct 2007 */ Lahey compiler does not like initialisation of variables in */ common with a data statement. *d up257.10 ebeg=1.d-5 *d up257.12 ebeg=1.e-5 */ *ident upnea022 */ errorr A. Trkov 30 Oct 2007 */ Lahey compiler identified several errors and warnings: */ - Subroutine "error" must be declared external in several routines. */ - Extend common "ewght" similar to common "weight" in groupr, */ introduce dummy common "temper", initialize with temperature "tempin", */ both needen in subroutine "egtwtf" (a more sophisticated patch */ might be needed). */ - Replace Hollerith constants "hmt" and "uline" with character. */ - Define constant "small" in two subroutines. */ - Define constant "a33" (PLEASE CHECK)! *i errorj.258 external error *i errorj.731 external error *i errorj.1362 external error *i errorj.2758 external error *i errorj.2996 external error *i errorj.3138 external error *i errorj.3487 external error *i errorj.3757 external error *i errorj.4099 external error *i errorj.5380 external error *i errorj.5825 external error *i errorj.5990 external error *i errorj.6360 external error *i errorj.6733 external error *i errorj.6853 external error *i errorj.7077 external error *i errorj.7142 external error *i errorj.7379 external error *i errorj.7433 external error *i errorj.7603 external error *i errorj.7655 external error *i errorj.7781 external error */ extend common "ewght" similar to common "weight" in groupr */ introduce dummy common "temper", initialize with temperature "tempin" */ both needen in subroutine "egtwtf" *d errorj.242 common/ewght/iwt,jsigz,jtemp common/temper/temp(10),ntemp *i errorj.351 ntemp=1 jtemp=1 temp(1)=tempin *d errorj.1356 common/ewght/iwt,jsigz,jtemp *d errorj.3484 common/ewght/iwt,jsigz,jtemp *d errorj.4090 common/ewght/iwt,jsigz,jtemp *d errorj.5375 common/ewght/iwt,jsigz,jtemp *d errorj.5568 common/ewght/iwt,jsigz,jtemp *d errorj.7260 common/ewght/iwt,jsigz,jtemp */ Replace Hollerith constants with character *i errorj.7769 character*2 hmt character*5 uline *d errorj.7782 data hmt/'mt'/, uline/'-----'/ *i errorj.8108 character*2 hmt character*5 uline *d errorj.8119 data hmt/'mt'/, uline/'-----'/ */ define constant small (please, check !!!!!) *i errorj.8275 data small/1.d-10/ *i errorj.8497 data small/1.d-10/ */ define constant a33 (please, check !!!!!) *i errorj.8622 a33 =a3*a3 *ident upnea023 */ errorr A. Trkov 04 Dec 2007 */ - Insufficientlength for the array at index iscr was reserved, */ causing the next block of data to be corrupted. */ All cases are affected where union grid>654 energy points. */ - Increase array size from 8M to 12M to process covariance */ matrices in 640 groups (external reference spectra for */ dosimetry). *d errorj.237 common/estore/a(12500000) *d errorj.272 namax=12500000 *d errorj.3131 common/estore/a(12500000) *d errorj.2772 nwds=max(npage+50,nunion+1+8) *d errorj.3499 nwscr=max(2*npage+50,nun1+8) *i errorj.3520 if (nw.gt.nwscr) & call error('colaps','storage exceeded.',' ') *d errorj.3758 data nxmax/800/, irmax/60/ *ident upnea024 */ covr A. Trkov 04 Dec 2007 */ Increase array size from 300k to 900k to process covariance */ matrices in 640 groups (external reference spectra for */ dosimetry). */*d up111.12 */ common/storec/a(900000) */*d up111.8 */ common/storec/a(900000) */*d up111.10 */ data iamax/900000/, niad/15/, ipr/1/, ntics3/600/ *ident upnea025 */ reconr A. Trkov 09 Dec 2007 */ Allow processing of MT261, usen in the dosimetry library IRDF */ to store reference neutron fields (spectra). */ The patch has no impact on cross section processing. *d reconr.1689 if ((mth.ge.251.and.mth.le.300).and.mth.ne.261) go to 150 *ident upnea026 */ groupr A. Trkov 09 Dec 2007 */ Allow processing of MT261, usen in the dosimetry library IRDF */ to store reference neutron fields (spectra). */ The patch has no impact on cross section processing. *i groupr.3967 if (mtd.eq.261) mt=261 */ *ident upnea027 */ acer A. Trkov 14 Jan 2008 */ Implement enhancements that allow processing of dosimetry data */ including metastable nuclide excitation functions in MF10. */ Internally the ace MT numbers were extended according to the */ following convention: */ MT* = MT + 1000*(10+LFS) */ where LFS is the final state of the nuclide. *i acer.11525 c strip the leading digits from MT in dosimetry reactions if (i.gt.999) i=i-1000*(i/1000) *d acer.14319 c reserve all available space for scratch nwscr=-1 *d acer.14357 do while (mfh.ne.3 .and. mfh.ne.10) call tofend(nin,0,0,a(iscr)) call contio(nin,0,0,a(iscr),nb,nw) if (mfh.gt.10 .or. math.le.0) & call error('acedos','no x-sect. data for desired mat.',' ') end do *d acer.14367 if(mfh.gt.3) go to 110 *d acer.14371 */ guard against array overflow *i acer.14380 if(jscr.gt.nwscr) & call error('acedos','aray storage exceeded' & ,' Execution terminated') *i acer.14383 if(jscr.gt.nwscr) & call error('acedos','aray storage exceeded' & ,' Execution terminated') *i acer.14409 call contio(nin,0,0,a(iscr),nb,nw) *i acer.14411 c ***locate first reaction in file 10 call contio(nin,0,0,a(iscr),nb,nw) if (mfh.gt.10 .or. math.le.0) goto 120 do while (mfh.ne.10) call tofend(nin,0,0,a(iscr)) call contio(nin,0,0,a(iscr),nb,nw) if (mfh.gt.10 .or. math.le.0) goto 120 end do 110 continue c ***loop over reactions on nin do while (mfh.ne.0) ns=max(1,n1h) xss(lsig-1+j)=l if (mfh.ne.0) then if (mth.ne.1) then do is=1,ns jscr=iscr call tab1io(nin,0,0,a(jscr),nb,nw) lfs=l2h xss(mtr-1+j)=mth+1000*(10+lfs) nr=nint(a(iscr+4)) ne=nint(a(iscr+5)) intr=nint(a(iscr+7)) jscr=jscr+nw if(jscr.gt.nwscr) & call error('acedos','aray storage exceeded' & ,' Execution terminated') do while (nb.ne.0) call moreio(nin,0,0,a(jscr),nb,nw) jscr=jscr+nw if(jscr.gt.nwscr) & call error('acedos','aray storage exceeded' & ,' Execution terminated') enddo if (nr.ne.1.or.intr.ne.2) then xss(l)=nr l=l+1 do i=1,nr xss(l+2*i-2)=a(iscr+4+2*i) xss(l+2*i-1)=a(iscr+5+2*i) enddo l=l+2*nr else xss(l)=0 l=l+1 endif xss(l)=ne k=iscr+6+2*nr l=l+1 do i=1,ne xss(l)=a(k)/emev xss(l+ne)=a(k+1) l=l+1 k=k+2 enddo l=l+ne j=j+1 enddo endif call tosend(nin,0,0,a(iscr)) call contio(nin,0,0,a(iscr),nb,nw) endif enddo 120 continue */ allow more digits for dosimetry mt's *d acer.14496 & '' reaction mt = '',i6,3x,a10/'' interpolation: '',12i6)') *d acer.14501 & '' reaction mt = '',i6,3x,a10/'' linear interpolation'')') */ allow processing of dosimetry files *d acer.407 else if (iopt.lt.7.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.2) 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 *d acer.17692 else if (ht.eq.'d'.or.ht.eq.'y') then */ *ident upnea028 */ acer A. Trkov 22 Jan 2008 */ Increase the size of the work array from 180000 to 510000 */ to process U-238 and Gd-nat from IRDF-2002. *d up123.5 common/astore/a(510000) *d up123.7 data namax/510000/, nidmax/27/ *d up123.9 common/astore/a(510000) *d up123.11 common/astore/a(510000) *d up123.13 common/astore/a(510000) *d up123.15 common/astore/a(510000) *d up123.17 common/astore/a(510000) *d up123.19 common/astore/a(510000) *d up123.21 common/astore/a(510000) *d up123.23 common/astore/a(510000) *d up123.25 data namax/510000/ *d up123.27 common/astore/a(510000) *d up123.29 common/astore/a(510000) *d up123.31 common/astore/a(510000) *d up123.33 common/astore/a(510000) *d up123.35 common/astore/a(510000) *d up123.37 common/astore/a(510000) *d up123.39 common/astore/a(510000) *d up123.41 common/astore/a(510000) */ *ident upnea029 */ groupr A. Trkov, 6-Feb-2008 */ Define minimum cross section for printout as 1.e-9 */ for consistency with other parts of the code. *i groupr.4286 data smin/1.d-9/ *i groupr.4289 data smin/1.e-9/ *d groupr.4432 if (a(ised-1+ik+nk*(ig-1)).gt.smin) go to 280 */ *ident upnea030 */ errorr A. Trkov, 24-May-2008 */ Undo an "ej" update to force upper energy limit to */ 20 MeV when iread=0 (why was it needed?) *d errorj.3535,3545 */ *ident upnea031 */ matxsr - D. L. Aldama, NDS/IAEA Consultant, May 2008 */ Need more space (for processing ORNL 421 energy group structure) */ subroutine vector *d up171.37 dimension b(30000) *d up171.39 maxb=30000 */ *ident upnea032 */ acer A. Trkov, 30 May 2008 */ Plots of discrete inelastic make sense below 5 MeV *d acer.19586 c limit discrete inelastic plots to 5 MeV if (x.gt.xmax) xmax=min(x,5.) */ *ident upnea033 */ njoy A. Trkov, 17 June 2008 */ Upgrade intgio to conform with latest format extensions *d up118.11 c if any unit is zero, it is not used. Parameter nw determines c the number of entries read or written, as well as the format c for formatted files; nw is an input quantity. If 0