*/ */ OECD/NEA compilation of NJOY updates */ compatible with the official patch distribution up161 */ *ident upijs65 */ moder - A. Trkov/A. Hogenbirk, 1-Oct-2006 */ Declare error external in routine file1x *d moder.1116 external tab1io,moreio,listio,error */ *ident upijs66 */ acer - A. Trkov/C. Broeders, 1-Oct-2006 */ Correct syntax of parameter statement *d up147.31 parameter (idmx=2000) */ *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 upnea002 */ matxsr - C. Broeders, 6-Oct-2006 *d matxsr.1880 *d matxsr.1882,1883 *i matxsr.1884 call repoz(irefr) *i matxsr.1887 call findf(mat,mf,mt,nscr) call contio(nscr,nscrr,0,b(1),nb,nw) *ident upnea003 */ ccccr - C. Broeders, 6-Oct-2006 */ Increase size of array e from 2000 to 8000 *d ccccr.128 common/enddat/e(8000) *d ccccr.145 maxe=8000 *d ccccr.513 common/enddat/e(8000) *d ccccr.708 common/enddat/e(8000) *d ccccr.1005 common/enddat/e(8000) *d ccccr.1164 common/enddat/e(8000) *d ccccr.1980 common/enddat/e(8000) *d ccccr.2386 common/enddat/e(8000) *d ccccr.2536 common/enddat/e(8000) *d ccccr.3066 common/enddat/e(8000) */ *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 upnea005 */ groupr - C. Broeders, 6-Oct-2006 */ check validity and limits of parameters *i up105.31 character*70 cm1,cm2 *d groupr.5334 SAVE *d groupr.5634 if(inow.le.100000)return *i groupr.5635 if(inow.gt.100000)then write(cm1,'(2(a,1p,e12.4))') ' ep=',ep,' enow=',enow write(cm2,'(5(a,i8))') ' ndnow=',ndnow,' npnow=',npnow & ,' mnow=',mnow,' lnow=',lnow,' inow=',inow call error('f6ddx',cm1,cm2) endif */ *ident upnea006 */ matxsr - C. Broeders, 6-Oct-2006 */ increase array sizes of a and ia from 50000 to 200000 */ increase array size ha from 25000 to 100000 (equiv.to ia) */ increase array size b from 2000 to 80000 */ check for validity with error stop *d matxsr.393 common/mstore/a(200000) *d matxsr.405 isiza=200000 *d matxsr.496 common/mstore/a(200000) *d matxsr.505 dimension ia(200000),ha(100000) *d matxsr.512 maxw=50000 *d matxsr.762 common/mstore/a(200000) *d matxsr.770 dimension ia(200000),ha(100000) *d matxsr.887 common/mstore/a(200000) *d matxsr.906 dimension ia(200000),ha(100000) *d matxsr.1475 common/mstore/a(200000) *d matxsr.1482 common/hollr/hvps(3000),hmtx(3000) *d matxsr.1487 dimension ia(200000),ha(100000) *d up88.21 dimension b(8000) *d up88.23 maxb=8000 *i matxsr.1474 character*85 cm2 *i matxsr.1635 if(lin.lt.1.or.lin.gt.maxb)then write(cm2,'(6(a,i8))') &' lz=',lz,' nl=',nl,' nz=',nz,' iz=',iz,' lin=',lin,' maxb=',maxb call error('vector','lin>maxb',cm2) endif if(lout.lt.1.or.lout.gt.isiza)then write(cm2,'(6(a,i8))') &' ivdat=',ivdat,' n1i=',n1i,' ning=',ning,' ig=',ig, &' lout=',lout,' isiza=',isiza call error('vector','lout>isiza',cm2) endif *d matxsr.1806 common/mstore/a(200000) *d matxsr.1814 common/hollr/hvps(3000),hmtx(3000) *d matxsr.1821 dimension ia(200000),ha(100000) *d matxsr.1971 common/mstore/a(200000) *d matxsr.1975 dimension ia(200000) *d matxsr.2071 common/mstore/a(200000) */ *ident upnea007 */ groupr - C. Broeders, 6-Oct-2006 (original patch) */ A. Hebert, 11-Nov-2006 (revision) */ fix dimension for flux and sig *i groupr.251 dimension flux(10,10),sig(10,10) *i groupr.277 do i=1,iamax a(i)=0. enddo *i groupr.4772 save iptest *i groupr.4780 data iptest/0/ *d groupr.5191,5192 & .and.iptest.eq.0 & .and.(ed.lt.up*elo.or.ed.gt.dn*ehi))then write(nsyso,'('' normalization '',1p,e12.4,1p,e15.6)') *i groupr.5193 write(nsyso,'(a)') & ' further normalization messages will be suppressed' write(*,'(a)') & ' further normalization messages will be suppressed' iptest=1 endif */ *ident upnea008 */ matxsr - V. Sinitsa, 6-Oct-2006 */ Fix variable (change "a" into "b") *d matxsr.1108 if (abs(b(loc)).ge.eps) go to 360 */ *ident upnea009 */ groupr - A. Trkov, 10-Nov-2006 */ Fix unit base interpolation for spectra */ (problem reported by A. Hebert processing Nb-94 */ from JEFF-3.1) *i groupr.8792 l=lnow+ne*(ng+1) *i groupr.8885 khi=nnow+ne*(ng+1) nrhi=nint(c(khi+4)) nphi=nint(c(khi+5)) *d groupr.8897,8900 c save highest emitted particle energy in xhi llo=nnow+(ng+1)*(nne-1) lhi=nnow+(ng+1)*nne klo=khi nrlo=nrhi nplo=nphi khi=klo+6+2*nrlo+2*nplo nrhi=nint(c(khi+4)) nphi=nint(c(khi+5)) elo=c(klo+1) xlo=c(klo+4+2*nrlo+2*nplo) ehi=c(khi+1) xhi=c(khi+4+2*nrhi+2*nphi) *d up161.31,47 *d up161.51 jnt=int-20 call terp1(elo,xlo,ehi,xhi,ed,xend,jnt) *d up161.62 ir=1 *d up161.65 ir=1 *d up161.67 call terp1(elo,flo,ehi,fhi,ed,fe,jnt) */ Restore deleted comments in up161 *b groupr.8910 c c ***upscatter is not allowed in secondary energy */ *ident upnea010 */ groupr - A. Trkov, 3-Jan-2007 */ (Based on feedback from Kosako-san through K. Shibata) */ Affected processing Nb-93 from JENDL-3.3 */ Increase max.number of lo=2 gammas *d groupr.7957 lmax=500 */ *ident upnea011 */ heatr - A. Trkov, 3-Jan-2007 */ (see upnea010) */ Increase max.number of lo=2 gammas *d heatr.4120 lmax=500 */ *ident upnea012 */ broadr - A. Trkov, 3-Jan-2007 */ Increase the max.number of low threshold reactions */ (Requested by Kosako-san to process Ag-110m from JENDL-3.3) *d broadr.114 dimension temp2(10),tt(20),mtr(20),mti(20) *d broadr.138 ntt=20 */ *ident upnea013 */ matxsr A. Trkov, 22-March 2007 */ the size assigned to maxw is incompatible with transax */ revert the change in upnea006 from 50000 back to 5000 *d upnea006.16 maxw=5000 */ *ident upnea014 */ groupr S. Kahler, 18-June 2007 */ Problem identified by C. Broeders for externally defined */ weighting spectra with 6-digit precision (14 June 2007). *d groupr.2596 enext=sigfig(enext,6,1) *ident upnea015 */ thermr M. Mattes, 23 May 2007 (original label: up.lasym) */ The evaluations for liquid hydrogen and deuterium are */ stored in ENDF-6 format with LASYM=1 and LAT=1. */ For a correct processing with NJOY-99.up161 the following */ patch is necessary if the short collision time approximation */ (SCTA) is required for higher energy transfers *d thermr.1977,1978 bb_m=bb if (lat.eq.1) bb_m=bb*tev/tevz if (bb_m.gt.beta(nbeta)) go to 170 if (bb_m.lt.beta(1)) go to 170 */ *ident upnea016 */ purr V Sinitsa, 03-May 2007 (original label: up_purr) */ fix incorrect fluctuation factors for heating cross-section */ in probability table */ Note: R.C. Little reported to MCNPX forum that the problem is */ solved in "up172", which is not yet released. */ Until the official release the present patch is proposed. *d purr.453 *d up62.11 *d purr.459,460 *d up62.13 *d purr.466,467 *d up62.15 *d purr.473,476 *d up62.17 *d purr.478 do i=2,4 h=a(k+i)*a(n1+j+2*nbin) if (lssf.eq.0.and.sigu(i,1,1).ne.zero) h=h/sigu(i,1,1) a(l)=a(l)+h end do if (a(n1+j+nbin).ne.zero) a(l)=a(l)/a(n1+j+nbin) if (lssf.ne.0) a(l)=a(l)/a(k+1) */