*ident upiaea1
*/ groupr - A.Trkov, IAEA
*/ Local updates from NJOY97 that were not implemented
*/ Need more space for the flux calculator (Case: U-238)
*d up89.6
dimension a(400000)
*d up89.8
iamax=400000
*/
*ident upijs57
*/ groupr A.Trkov, 9-March-1999
*/ groupr is caught in an infinite loop for Be-9 from ENDF/B-VI
*/ on a PC with Lahey compiler.
*/ It seems the products inside an "if" statements are
*/ computed differently than outside. The program does not
*/ recognise that ep EQUALS "test" when written as a product.
*d groupr.6054
test=shade*epn
if (idis.gt.0.and.ep.lt.test) epn=test
*/
*/ Old proposal from C.Dean
*d groupr.2745,2746
b(iz+3+li)=(sigz(iz)-sam)*wtf*(1-beta)
*/
*ident upijs59
*/ acer A.Trkov 20-aug-1999
*/ If pointwise representation in CM system, csn should be used
*/ (pointed out by Harry Wienke).
*d acer.3394,3396
if (csn.ge.a(ll).and.csn.le.a(ll+2))
& call terp1(a(ll),a(ll+1),a(ll+2),a(ll+3),
& csn,fmu,lang-10)
*/
*ident upijs61
*/ acer A.Trkov 3-dec-1999
*/ fix6 may run out of space without warning
*d acer.3247
dimension a(2000)
*d up3.38
data namax/2000/
*i acer.3262
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3272
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3278
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3280
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3282
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3284
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3290
if(nw.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3296
if(nw+l.gt.namax) call error('fix6','storage exceeded.',' ')
*i acer.3299
if(nw+l.gt.namax) call error('fix6','storage exceeded.',' ')
*/
*ident upijs62
*/ groupr A.Trkov, 29-Apr-2002
*/ - Fix inconsistent usage of output weighting flux unit number
*/ - Fix logic when searching for the right flux point
*i groupr.80
c * note: weighting flux file is always written binary *
*d groupr.99
c * ninwt tape unit for flux parameters (binary) *
*d groupr.272
*d groupr.2290
ninwt=iabs( ninwt)
call openz(-ninwt,1)
*d groupr.2294
& ehi,sigpot,nflmax,-ninwt,jsigz
*d groupr.2307,2308
call openz(-ninwt,0)
write(nsyso,'(/'' ninwt......'',i4)') -ninwt
*d groupr.3037
if (e.gt.el*(1-small).and.e.lt.en*(1+small)) go to 230
*/
*ident upijs63
*/ purr A.Trkov, May 2002
*/ Increase scratch space to process Pu-239 from JEF-2.2
*d purr.95
maxscr=12000
*/
*ident upijs64
*/ groupr A.Trkov, July 2002
*/ There is an error in Cl-37 in ENDF/B-VI Rev.8
*/ MAT 1731 MF 15 MT 102
*/ The first energy for the gamma yields is zero. It
*/ redefines enext in getsed to zero, which is
*/ interpreted as a flag to do initialisation in
*/ getgyl (called from getff). Since 'yl' is
*/ already reserved, groupr crashes.
*d groupr.8697
if (elo.gt.0 .and. elo.lt.enext) enext=elo
*/
*ident upiaea2
*/ groupr - A.Trkov, IAEA, Feb-2003
*/ Increase array size for Legendre coefficients
*i groupr.4756
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.4764
dimension term(mxlg),terml(mxlg)
*i groupr.5209
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.5212
dimension term(mxlg),x(10),y(10,mxlg)
*d groupr.5329,5330
c maximum legendre coefficients
parameter (mxlg=65)
dimension cnow(*),term(*),p(mxlg)
dimension x(10),y(10,mxlg),yt(mxlg)
*d groupr.5333
external f6ddx,f6psp,f6dis,legndr,error
*i groupr.5358
if(nl.gt.mxlg) call error('f6cm','nl>mxlg',' ')
*d groupr.5586
c maximum legendre coefficients
parameter (mxlg=65)
dimension cnow(*),p(mxlg)
*d groupr.5768
c maximum legendre coefficients
parameter (mxlg=65)
dimension cnow(*),p(mxlg)
*i groupr.5630
if(nl.gt.mxlg) call error('f6ddx','nl>mxlg',' ')
*i groupr.5992
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.5995
dimension term(mxlg),p(mxlg),amu(50),fmu(50),qp(8),qw(8)
*i groupr.6130
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.6133,6134
dimension term1(mxlg),term2(mxlg),p(mxlg)
dimension qp(8),qw(8)
*i groupr.6733
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.6740
dimension flo(mxlg),fhi(mxlg)
*i groupr.7314
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.7318
dimension b(6),alo(mxlg),ahi(mxlg)
*i groupr.7929
c maximum legendre coefficients
parameter (mxlg=65)
*d groupr.7942
dimension fl(mxlg)
*/
*ident upiaea3
*/ acer - A.Trkov, IAEA, Feb-2003
*/ declare "error" external to avoid conflict with intrinsic function
*i up69.66
external error
*/
*ident upfndl1
*/ matxsr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ Need more space (for processing JENDL-3.3)
*/ subroutine band
*d matxsr.1973
dimension b(30000)
*d matxsr.1978
maxb=30000
*/ subroutine shufl
*d matxsr.2078
dimension b(30000)
*d matxsr.2080
maxb=30000
*/
*ident upfndl2
*/ gaspr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ Need more space (case Ni-058 from JEFF-3.0)
*d gaspr.28
dimension egas(80000),sgas(5,80000)
*d gaspr.41
maxg=80000
*ident upfndl3
*/ purr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ to allow PT for multi-isotope materials when
*/ not all the isotopes have unresolved resonance data
*d purr.624
*i purr.651
if (ier.eq.ner) go to 110
*/
*ident upfndl4
*/ acer - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ Format extension for negative energies (overlap)
*d acer.4947,4948
write(nsyso,'('' energy range: '',1p,e11.4,
& '' - '',e11.4,'' ev'')') urlo,urhi
*/
*ident upfndl5
*/ groupr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ Needed to process Be-9 from JEFF-3.0 evaluation
*/ MT=875-891 for (n,2n) splitted reaction
*i groupr.1147
else if (mtd.ge.875.and.mtd.le.884) then
write(reac,'(''2n0'',i1)') mtd-875
else if (mtd.ge.885.and.mtd.le.890) then
write(reac,'(''2n'',i2)') mtd-875
else if (mtd.eq.891) then
reac='2nc'
*i groupr.3964
if (iverf.ge.6.and.mtd.ge.875.and.mtd.le.891) mt=mtd
*i groupr.4331
if (mfd.ge.31.and.mfd.le.36.and.iverf.ge.6.and.
& (mtd.ge.875.and.mtd.lt.891)) go to 400
*i groupr.8014
if (mth.ge.875.and.mth.lt.891) za2=1
*i groupr.8330
if (iverf.ge.6.and.mth.ge.875.and.mth.le.890) mt0=875
*/
*/ matxsr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ Needed to process Be-9 from JEFF-3.0 evaluation
*/ MT=875-891 for (n,2n) splitted reaction
*d matxsr.1418
290 if (mt.gt.891) go to 300
*i matxsr.1433
if (mt.ge.875.and.mt.lt.885) write(strng,'(''2n0'',i1)') mt-875
if (mt.ge.885.and.mt.lt.891) write(strng,'(''2n'',i2)') mt-875
if (mt.eq.891) write(strng,'(''2ncn'')')
*i matxsr.1504
k016=0
*i matxsr.1652
if (mt.eq.16) k016=1
if (k016.eq.1.and.mt.ge.875.and.mt.le.891) go to 310
*/
*ident upfndl6
*/ groupr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ subroutine namer corrected for mt=659, reac=d09
*/ It only affects groupr printout
*d groupr.1124
else if (mtd.ge.650.and.mtd.le.659) then
*/
*ident wlup2
*/ thermr - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ More space for new scattering law
*d thermr.101
dimension a(800000)
*d thermr.131
namax=800000
*/
*/ subroutine calcem - D. L. Aldama, NDS/IAEA Consultant, Nov-2004
*/ TAB1 records are larger than npage=306
*/ moreio should be used
*/ required by thermal scattering law generated by NDS/IKE
*/
*d thermr.1543
lmore=loc
call tab1io(nendf,0,0,a(loc),nb,nw)
do while (nb.ne.0)
lmore=lmore+nw
call moreio(nendf,0,0,a(lmore),nb,nw)
enddo
*d thermr.1572
lmore=loc
call listio(nendf,0,0,a(loc),nb,nw)
do while (nb.ne.0)
lmore=lmore+nw
call moreio(nendf,0,0,a(lmore),nb,nw)
enddo
*d thermr.1598
lmore=loc
call listio(nendf,0,0,a(loc),nb,nw)
do while (nb.ne.0)
lmore=lmore+nw
call moreio(nendf,0,0,a(lmore),nb,nw)
enddo
*d thermr.1602
lmore=loc
call tab1io(nendf,0,0,a(loc),nb,nw)
do while (nb.ne.0)
lmore=lmore+nw
call moreio(nendf,0,0,a(lmore),nb,nw)
enddo
*/
*/ident up2_thermr
*/ thermr - M. Mattes/IKE ---------------------------------------mm
*/ maximum.energy transfer at higher temperatures (print only)
*i thermr.1622
if (lat.eq.1) tmax=tmax*tevz/(bk*temp)
*/ ---------------------------------------------------end up2_thermr
*ident up3_thermr
*/ more incident energies necessary for ZrH for an adequate
*/ represention of the neutron scattering xs in comparison
*/ with experimental results (.1 < E_i < 1 eV)
*d thermr.1422,thermr.1423
dimension egrid(79)
dimension ubar(79)
*d thermr.1427
data ngrid/79/
*d thermr.1433,thermr.1436
& .030613d0,.042757d0,.056925d0,.081972d0,
* .1d0, .111573d0, .12d0, .13d0, .145728d0, .16d0, .17d0,
& .184437d0,
* .195d0, .2277d0, .24d0, .2510392d0,.2705304d0,.2907501d0,
& .3011332d0,.3206421d0,.3576813d0,
* .38d0, .4d0, .4170351d0, .44d0, .48d0, .5032575d0, .53d0,
& .56d0, .59d0, .6249328d0, .65d0, .69d0, .72d0, .75d0,
* .7821141d0, .82d0, .89d0, .9506956d0,1.0137432d0,1.1664337d0,
*d thermr.1455,thermr.1458
& .030613e0,.042757e0,.056925e0,.081972e0,
* .1e0, .111573e0, .12e0, .13e0, .145728e0, .16e0, .17e0,
& .184437e0,
* .195e0, .2277e0, .24e0, .2510392e0,.2705304e0,.2907501e0,
& .3011332e0,.3206421e0,.3576813e0,
* .38e0, .4e0, .4170351e0, .44e0, .48e0, .5032575e0, .53e0,
& .56e0, .59e0, .6249328e0, .65e0, .69e0, .72e0, .75e0,
* .7821141e0, .82e0, .89e0, .9506956e0,1.0137432e0,1.1664337e0,
*/
*/ --------------------------------------------------end up3_thermr
*ident up1_leapr
*/
*/ if number(>200) for alpha and/or beta values then
*/ increase array sizes plus working buffers
*/ e.g. beta(200) -> beta(400) for H2O
*d leapr.164
common/ab/nalpha,nbeta,naint,nbint,alpha(200),beta(400)
*d leapr.173
common/lstore/a(7500000)
*d leapr.178
data nbmax,namax/400,200/
*d leapr.189
maxa=7500000
*d leapr.391
mscr=4000
*d leapr.420
common/ab/nalph1,nbeta1,naint,nbint,alph1(200),beta1(400)
*d leapr.426
dimension maxt(400)
*d leapr.794
common/ab/nalpha,nbeta,naint,nbint,alpha(200),beta1(400)
*d leapr.1252
common/ab/nalpha1,nbeta1,naint,nbint,alpha(200),beta1(400)
*d leapr.1852
common/ab/nalph1,nbeta1,naint,nbint,alpha(200),beta1(400)
*/
*/ IKE evaluation of H(H2O) creates more pairs of alpha
*/ and S(alpha,beta) than npage
*i leapr.3122
l_mm=1+nw
do while (nb.ne.0)
call moreio(0,nout,nprnt,scr(l_mm),nb,nw)
l_mm=l_mm+nw
enddo
*/ -------------------------------------------------end up1_leapr
*ident up2_leapr
*/ for H(H2O), D(D2O) NS should be equal 1
*d leapr.2976,2977
if(nss.gt.0) scr(5)=6*(nss+1)
scr(6)=nss
*/ -------------------------------------------------end up2_leapr
*ident up3_leapr
*/ T-eff calculation
*d leapr.1557
tempf(itemp)=(tbeta+twt)*tempf(itemp)+tsave
*/ -------------------------------------------------end up3_leapr
*ident up4_leapr
*/ generation of more than 10 temperatures
*d leapr.166,167
common/te/tempr(20),tempf(20),tempf1(20)
common/dw/dwpix(20),dwp1(20)
*d leapr.179
data ntmax/20/
*d leapr.600,601
common/te/tempr(20),tempf(20),tempf1(20)
common/dw/dwpix(20),dwp1(20)
*d leapr.797
common/te/tempr(20),tempf(20),tempf1(20)
*d leapr.1256
common/te/tempr(20),tempf(20),tempf1(20)
*d leapr.1258
common/dw/dwpix(20),dwp1(20)
*d leapr.1856
common/te/tempr(20),tempf(20),tempf1(20)
*d leapr.2651,2652
common/te/tempr(20),tempf(20),tempf1(20)
common/dw/dbw(20),dbw1(20)
*/ --------------------------------------------------end up4_leapr
*ident up5_leapr
*/ correct directory
*i leapr.2797
scr(5)=scr(5)+1
if(iel.ne.0) scr(5)=scr(5)+1
*/ --------------------------------------------------end up5_leapr
*/
*ident up_acer
*/ id-name of thermal data set with 6 characters else blank
*i acer.358
if (nch.eq.0) nch=6
*/
*/ more than 64 bins wt(65)
*d acer.13079
dimension wt(401)
*/
*/ increase of scratch buffer (?)
*d acer.13098
ninmax=8000
*/
*/ ------------------------------------------------jan05------end
*/
*/ Kazuaki Kosako, Shimizu Corporation
*/ MF5 and MF6 INT=21-25 laws modifications
*/ in groupr
*/
*ident upshim
*/
*i groupr.548
ee=0
*d groupr.550
*/
*/*d groupr.5586
*/ dimension cnow(*),p(64)
*i groupr.5668
if (na.gt.64) call error('f6ddx',
& 'order of legendre expansion > 64 ',' ')
*/*d groupr.5768
*/ dimension cnow(*),p(64)
*i groupr.5811
if (na.gt.64) call error('f6dis',
& 'order of legendre expansion > 64 ',' ')
*i groupr.8641
parameter (npmax=15001,npmax0=npmax-1,mxset=200,mxnrf1=50)
common/mainio/nsysi,nsyso,nsyse,ntty
common/nalf5a/npf1(mxset),nbtf1(mxnrf1),intf1(mxnrf1)
common/nalf5b/eintf1(mxset),xdatwk(npmax),xdatf1(npmax,mxset),
1 ansf1(npmax),ydatwk(npmax),ydatf1(npmax,mxset),
2 epmax(mxset)
*i groupr.8647
external f5xlin,f5xint
*i groupr.8750
nr=nint(c(l+4))
intchk=0
do k=1,nr
intnow=nint(c(nnt+ic-1+2*k))
if (intnow.le.0.or.(intnow.gt.6.and.intnow.le.20).or.
& intnow.gt.25) then
write(strng,'(a,i6)') 'int=',intnow
call error('getsed','interplation error',strng)
endif
if (intnow.gt.intchk) intchk=intnow
enddo
*i groupr.8767
if (intchk.ge.21.and.intchk.le.25) then
if (nne.gt.mxset)
& call error('getsed','storage exceeded - nne',' ')
eintf1(nne)=c(iraw+1)
npnow=nint(c(iraw+5))
nrf1=nint(c(iraw+4))
if (npnow.gt.npmax0)
& call error('getsed','storage exceeded - npnow',' ')
if (nrf1.gt.mxnrf1)
& call error('getsed','storage exceeded - nrf1',' ')
intone=0
do j=1,nrf1
nbtf1(j)=nint(c(iraw+4+2*j))
intf1(j)=nint(c(iraw+5+2*j))
if (intf1(j).eq.1) intone=1
enddo
do i=1,npmax
xdatwk(i)=0
ydatwk(i)=0
enddo
ipos=iraw+6+2*nrf1
do j=1,npnow
isw1=ipos+2*(j-1)
xdatwk(j)=c(isw1)
ydatwk(j)=c(isw1+1)
enddo
emaxf1=xdatwk(npnow)
epmax(nne)=emaxf1
do j=1,npnow
xdatwk(j)=xdatwk(j)/emaxf1
ydatwk(j)=ydatwk(j)*emaxf1
enddo
if (xdatwk(1).gt.zero.and.intf1(1).eq.1) then
if (ydatwk(1).eq.zero) xdatwk(1)=0
endif
c
npnew=0
call f5xlin(nbtf1,intf1,nrf1,xdatwk,ydatwk,npnow,
& xdatf1(1,nne),ydatf1(1,nne),npmax0,npnew,
& nsyso)
sumf1=0
npf1(nne)=npnew
if (intone.eq.1) then
do j=2,npf1(nne)-2
if (xdatf1(j,nne).eq.xdatf1(j+1,nne)) then
s1=xdatf1(j,nne)*0.999995d+0
s2=xdatf1(j,nne)*1.000005d+0
if (xdatf1(j-1,nne).lt.s1) xdatf1(j,nne)=s1
if (xdatf1(j+2,nne).gt.s2) xdatf1(j+1,nne)=s2
endif
enddo
endif
do j=2,npf1(nne)
sumf1=sumf1+(xdatf1(j,nne)-xdatf1(j-1,nne))*
& (ydatf1(j,nne)+ydatf1(j-1,nne))/2
enddo
xdatf1(npnew+1,nne)=0
ydatf1(npnew+1,nne)=0
anorm=1
if (sumf1.gt.zero) anorm=1/sumf1
do j=1,npf1(nne)
ydatf1(j,nne)=anorm*ydatf1(j,nne)
enddo
endif
*i groupr.8782
if (intchk.ge.21.and.intchk.le.25) then
econst=0
else
*i groupr.8813
endif
*i groupr.8903
if (int.ge.21.and.int.le.25) then
call f5xint(ed,sed,eg,ng,nk,matd,mfd,ne,int,nne,
& ikt,elo,ehi,pe,nsyso)
else
*i groupr.8907
endif
*i groupr.8966
subroutine f5xlin(nbt,int,n1,xin,yin,n2,xout,yout,npmax,npout,
1 nsyso)
c ******************************************************************
c convert data to linear-linear form.
c originality of this routine is subroutine filex in the linear-2000
c code.
c ******************************************************************
*if sw
implicit real*8 (a-h,o-z)
*endif
external error,terp1,sigfig
save xcmin,errx,half
dimension xin(n2),yin(n2),xout(npmax),yout(npmax)
dimension nbt(n1),int(n1)
*if sw
data xcmin/1.0d-15/
data errx/5.0d-4/
data half/0.5d0/
*else
data xcmin/1.0e-15/
data errx/5.0e-4/
data half/0.5e0/
*endif
c
c-----initialize count of points in core and on scratch.
n2core=1
zero=0
c-----define first point in table.
xout(1)=xin(1)
yout(1)=yin(1)
c-----set flag to indicate if this is a threshold reaction.
ithres=0
if (yout(1).le.xcmin) ithres=1
n2p1=2
n2p2=3
c-----set up loop over interpolation ranges.
nr2=1
do 400 ir=1,n1
c-----define points in interpolation range and type of interpolation.
nr1=nr2+1
nr2=nbt(ir)
intype=int(ir)
c-----data check
minus=0
do i=nr1,nr2
if (yin(i).le.zero) minus=1
enddo
c
if (intype.gt.3.and.minus.eq.1) intype=2
c
c non-linear interpolation law requires sub-division. set up loop
c over points in current interpolation region.
c
c interpolation law branch.
if (intype-2) 50,80,100
c
c for histogram replace each energy point that is internal to the
c interpolation energy range by two energy points and replace each
c end point of the interpolation energy range by a single energy
c point (start of interval has already been stored).
c
50 continue
do 70 npt=nr1,nr2
n2core=n2core+2
if (n2core.gt.npmax) call error('f5xlin','storage exceeded',' ')
xout(n2core)=xin(npt)
yout(n2core)=yin(npt)
c-----eliminate duplicate points.
if (xout(n2core).ne.xout(n2core-2)) go to 60
xout(n2core-1)=xout(n2core)
yout(n2core-1)=yout(n2core)
n2core=n2core-1
n2p1=n2core+1
n2p2=n2p1+1
go to 70
60 continue
xout(n2core-1)=xout(n2core)
yout(n2core-1)=yout(n2core-2)
70 continue
n2core=n2core-1
if (ir.lt.n1) then
n2core=n2core+1
if (n2core.gt.npmax)
& call error('f5xlin','storage exceeded - n2core',' ')
xout(n2core)=xin(nr2)
yout(n2core)=yin(nr2)
endif
n2p1=n2core+1
n2p2=n2p1+1
go to 400
c
c for linear-linear interpolation just copy points to output array.
c
80 continue
do 90 npt=nr1,nr2
c-----core space for one more point required. if no room in core, thin
n2core=n2core+1
if (n2core.gt.npmax)
& call error('f5xlin','storage exceeded - n2core',' ')
xout(n2core)=xin(npt)
yout(n2core)=yin(npt)
90 continue
n2p1=n2core+1
n2p2=n2p1+1
go to 400
c
c non-linear interpolation law requires sub-division. set up loop
c over points in current interpolation region.
c
100 continue
do 300 npt=nr1,nr2
c-----initialize to range not saved
imsaved=0
c-----define upper energy limit of interval.
xend=xin(npt)
yend=yin(npt)
c if necessary insert max. energy or thermal point
130 continue
xtop=xend
if (xout(n2core).le.zero) go to 150
if (xtop.gt.2*xout(n2core)) xtop=2*xout(n2core)
if (xtop.ge.xend) go to 150
c-----interpolate cross section to new end
call terp1(xout(n2core),yout(n2core),xend,yend,xtop,ytop,intype)
c-----save end and set range saved flag
imsaved=1
xsave=xend
ysave=yend
c-----define end of interval at thermal
xend=xtop
yend=ytop
c-----define energy and cross section at two ends of interval.
150 continue
xn2p2=xend
yn2p2=yend
xn2=xout(n2core)
yn2=yout(n2core)
c-----do not subdivide if cross section is constant.
if (yn2.eq.yn2p2) go to 220
c
c do not sub-divide intervals within which the absolute value of
c the cross section is less than the minimum cross section of
c interest, accept near thresholds.
c
c-----if this is a threshold reaction do not use low cross section
c-----cutoff criteria in the vacinity of the threshold.
if (ithres.eq.0) go to 160
if (abs(yn2).lt.xcmin) go to 170
ithres=0
go to 170
c-----assume convergence if the absolute value of the cross section
c-----at both ends of the interval is less than the minimum cross
c-----section of interest.
160 continue
if (abs(yn2).le.xcmin.and.abs(yn2p2).le.xcmin) go to 220
c
c define energy at middle of interval.
c
c-----intype is now 3, 4, 5 or 6.
170 continue
if (intype-4) 190,180,190
c-----linear energy.
180 continue
xn2p1=half*(xn2+xn2p2)
go to 200
190 continue
xn2p1=sqrt(xn2*xn2p2)
c-----round midpoint.
200 continue
xn2p1=sigfig(xn2p1,7,0)
c
c small energy interval convergence tests.
c
c-----if energy at middle of interval is less than allowable energy
c-----spacing only keep the two ends of the interval.
if (xn2p1.le.xn2.or.xn2p1.ge.xn2p2) go to 220
c
c define cross section at middle of interval by interpolation law
c and linear-linear interpolation.
c
call terp1(xn2,yn2,xn2p2,yn2p2,xn2p1,yn2p1,intype)
call terp1(xn2,yn2,xn2p2,yn2p2,xn2p1,yaprox,2)
c
c-----test for convergence. if convergence keep midpoint of interval
c-----in order to allow accurate backward thinning before output.
if (abs(yn2p1-yaprox).le.abs(yn2p1*errx)) go to 210
c
c no convergence. shorten interval.
c
xn2p2=xn2p1
yn2p2=yn2p1
go to 170
c
c convergence. keep interval midpoint if backward thinning will be
c performed. otherwise only keep ends of interval.
c
210 continue
if (n2p2.gt.npmax)
& call error('f5xlin','storage exceeded - n2p2',' ')
c-----keep interval midpoint and endpoint.
xout(n2p1)=xn2p1
yout(n2p1)=yn2p1
xout(n2p2)=xn2p2
yout(n2p2)=yn2p2
n2core=n2p2
n2p1=n2core+1
n2p2=n2p1+1
go to 230
c-----core space for one more point required. if no room in core, thin
c-----and unload one page of points to scratch.
220 continue
if(n2p1.gt.npmax)
& call error('f5xlin','storage exceeded - n2p1',' ')
c-----midpoint of interval is not required. only keep endpoint of
c-----interval.
xout(n2p1)=xn2p2
yout(n2p1)=yn2p2
n2core=n2p1
n2p1=n2core+1
n2p2=n2p1+1
c-----if not end of current interval continue. otherwise
c-----move to next interval.
230 continue
if (xout(n2core).lt.xend) go to 150
c-----if range saved, restore point and reset flag
if (imsaved.le.0) go to 300
imsaved=0
xend=xsave
yend=ysave
go to 130
300 continue
c
400 continue
npout=n2core
return
end
c
subroutine f5xint(ed,sed,eg,ng,nk,matd,mfd,ne,int,nne,ikt,elo,ehi,
& pe,nsyso )
c ******************************************************************
c compute secondary energy distribution for all sink groups
c simultaneously. laws 1 with int=21-25 is coded.
c ******************************************************************
*if sw
implicit real*8 (a-h,o-z)
*endif
parameter (npmax=15001,npmax0=npmax-1,mxset=200,mxnrf1=50)
parameter (mxwork=10+2*npmax)
common/nalf5a/npf1(mxset),nbtf1(mxnrf1),intf1(mxnrf1)
common/nalf5b/eintf1(mxset),xdatwk(npmax),xdatf1(npmax,mxset),
1 ansf1(npmax),ydatwk(npmax),ydatf1(npmax,mxset),
2 epmax(mxset)
dimension sed(nk,*),eg(*),c(mxwork)
character strng*60
external error,terp1,intega
save ist,jst1,jst2
*if sw
data small/1.d-10/
data ebig/1.d8/
data zero/0.d0/
*else
data small/1.e-10/
data ebig/1.e8/
data zero/0.e0/
*endif
c
if (nne.ge.ne) nne=ne-1
nne1=nne+1
npnow=npf1(nne)
ist=2
if (xdatf1(1,nne).ne.zero) then
write(strng,'(a,i6)') 'xdatf1(1,nne).ne.0 nne=',nne
call error('f5xint','invalid evaluation data',strng)
elseif (xdatf1(1,nne1).ne.zero) then
write(strng,'(a,i6)') 'xdatf1(1,nne1).ne.0 nne1=',nne1
call error('f5xint','invalid evaluation data',strng)
endif
c
c make union relative secondary nuetron energy mesh
c at requested energy range ( eintf1(nne) & eintf1(nne1) )
c
do i=1,npmax
xdatwk(i)=0
ydatwk(i)=0
enddo
do i=1,npnow
xdatwk(i)=xdatf1(i,nne)
enddo
c
do 170 j=2,npf1(nne1)-1
enow=xdatf1(j,nne1)
iadd=0
do i=ist,npnow
ehinow=xdatwk(i)
elonow=xdatwk(i-1)
ratio=1
if (ehinow.gt.zero) ratio=enow/ehinow-1
if (abs(ratio).lt.1.000d-5) go to 150
if (enow.gt.elonow.and.enow.lt.ehinow) then
iadd=i
go to 150
endif
enddo
150 continue
if (iadd.ge.ist) then
ratio=xdatwk(iadd)/enow
if (npnow+1.gt.npmax)
& call error('f5xint','storage exceeded - npnow+1',' ')
do k=iadd,npnow
i=npnow-k+iadd
xdatwk(i+1)=xdatwk(i)
enddo
xdatwk(iadd)=enow
npnow=npnow+1
ist=iadd
endif
170 continue
c
c interpolate secondary neutron energy distribution at ed energy
c
itype=int-20
np1=npf1(nne)-1
np2=npf1(nne1)-1
jst1=1
jst2=1
eint1=eintf1(nne)
eint2=eintf1(nne1)
c
c *** set maximum energy of secondary neutron
c
epmax1=epmax(nne)
epmax2=epmax(nne1)
epmaxn=0
call terp1(eint1,epmax1,eint2,epmax2,ed,epmaxn,2)
sumf1=0
eold=0
yold=0
c
do 200 i=1,npnow
enow=xdatwk(i)
ynow1=0
ynow2=0
do j=jst1,np1
jpos=j
if (enow.ge.xdatf1(j,nne).and.enow.lt.xdatf1(j+1,nne))
& go to 180
enddo
jpos=np1
180 continue
jpos1=jpos+1
jst1=jpos
x1=xdatf1(jpos,nne)
y1=ydatf1(jpos,nne)
x2=xdatf1(jpos1,nne)
y2=ydatf1(jpos1,nne)
call terp1(x1,y1,x2,y2,enow,ynow1,2)
do j=jst2,np2
jpos=j
if (enow.ge.xdatf1(j,nne1).and.enow.lt.xdatf1(j+1,nne1))
& go to 190
enddo
jpos=np2
190 continue
jpos1=jpos+1
jst2=jpos
x1=xdatf1(jpos,nne1)
y1=ydatf1(jpos,nne1)
x2=xdatf1(jpos1,nne1)
y2=ydatf1(jpos1,nne1)
call terp1(x1,y1,x2,y2,enow,ynow2,2)
ynow=0
call terp1(eint1,ynow1,eint2,ynow2,ed,ynow,itype)
ydatwk(i)=ynow
if (i.gt.1) sumf1=sumf1+(ynow+yold)*(enow-eold)/2
eold=enow
yold=ynow
200 continue
c
c define final secondary nuetron energy distribution data
c
anorm=1
if (sumf1.gt.zero) anorm=1/sumf1
do i=1,npnow
xdatwk(i)=xdatwk(i)*epmaxn
ydatwk(i)=anorm*ydatwk(i)/epmaxn
enddo
c
c calculates groupwise secondary nuetron energy distribution data
c
do ig=1,ng
ansf1(ig)=0
enddo
if (xdatwk(npnow).le.eg(2)) then
ansf1(1)=1
factn=1
go to 320
endif
c(1)=0
c(2)=0
c(3)=0
c(4)=0
c(5)=1
c(6)=npnow
c(7)=npnow
c(8)=2
isw=8
do i=1,npnow
isw=isw+1
c(isw)=xdatwk(i)
isw=isw+1
c(isw)=ydatwk(i)
enddo
ip=2
ir=1
do ig=1,ng
e1=eg(ig)
if (ig.eq.1) e1=0
e2=eg(ig+1)
if (ig.eq.ng) e2=ebig
call intega(ansf1(ig),e1,e2,c(1),ip,ir)
enddo
sump=zero
do ig=1,ng
sump=sump+ansf1(ig)
enddo
factn=1
if (sump.gt.zero) factn=1/sump
c
c store final result to sed array
c
320 continue
do ig=1,ng
sed(ikt,ig)=sed(ikt,ig)+ansf1(ig)*pe*factn
enddo
c
return
end
*/
*/ increase the allowed number of legendre terms in h6ddx
*/ to handle the new ENDF/B-VII mo95 evaluation.
*/
*d up15.9
dimension cnow(*),p(65)
*d up30.10
*i heatr.3298
data nlmax/65/
*/
*/ Kazuaki Kosako, Shimizu Corporation
*/ kinematic method
*/
*i heatr.55
c * kkerma 0/1=total (mt301) is energy balance / kinematic *
c * (default=0) *
*i heatr.91
common/heat6/kkerma
*d heatr.139
kkerma=0
read(nsysi,*) matd,npk,nqa,ntemp,local,iprint,break,kkerma
*i heatr.151
if (kkerma.eq.1) then
if (npk.gt.0) then
mtkk=0
do i=1,npk
if (mtk(i).eq.443) mtkk=i
enddo
if (mtkk.eq.0) then
npk=npk+1
if (kchk.eq.1) then
npkk=3*npk+7
else
npkk=npk+3
endif
if (npkk.gt.npkmax) call error('heatr',
& 'requested too many kerma mt-s (6+mt301 allowed).',' ')
mtk(npk)=443
endif
else
npk=1
mtk(npk)=443
endif
endif
*i heatr.4997
common/heat6/kkerma
*i heatr.5045
if (kkerma.eq.1) then
do i=2,npk
if (mtp(i).eq.443) mtkk=i
enddo
endif
*i heatr.5121
if (mt.eq.301.and.kkerma.eq.1) a(ibase+i)=c(mtkk)
*i heatr.5146
if (kkerma.eq.1) write(nsyso,'(/'' total kerma (mt=301) was '',
& ''replaced to kinematic kerma (mt=443).'')')
*/
*ident upcad
*/ groupr -- 11oct2002
*/ add the ecco33, ecco1968, tripoli315, xmas172 and Vitamin-J
*/ group structures with 7 significant decimal digits. those
*/ group structures are used in Europe for fast breeder and
*/ thermal reactor neutronics calculations. for compatibility
*/ with Calendf and Apollo
*b groupr.132
c * 18 xmas NEA-LANL
c * All new additional group structure with 7 significant
c * decimal digits compatible with CALENDF
c * 19 ecco 33-group structure
c * 20 ecco 1968-group structure
c * 21 tripoli 315-group structure
c * 22 xmas LWPC 172-group structure
c * 23 vit-J LWPC 175-group structure
*b groupr.1297
c 19 ecco 33-group structure
c 20 ecco 1968-group structure
c 21 tripoli 315-group structure
c 22 xmas LWPC 172-group structure
c 23 vit-J LWPC 175-group structure
*b groupr.1312
dimension eg19(34)
dimension eg20(1969)
dimension eg20a(95),eg20b(95),eg20c(95),eg20d(95),
* eg20e(95),eg20f(95),eg20g(95),eg20h(95),
* eg20i(95),eg20j(95),eg20k(95),eg20l(95),
* eg20m(95),eg20n(95),eg20o(95),eg20p(95),
* eg20q(95),eg20r(95),eg20s(95),eg20t(95),
* eg20u(69)
dimension eg21(316)
dimension eg21a(95),eg21b(95),eg21c(95),eg21d(31)
dimension eg22(173)
dimension eg22a(95),eg22b(78)
dimension eg23(176)
dimension eg23a(95),eg23b(81)
equivalence (eg20a(1),eg20(1)),(eg20b(1),eg20(96)),
* (eg20c(1),eg20(191)),(eg20d(1),eg20(286)),
* (eg20e(1),eg20(381)),(eg20f(1),eg20(476)),
* (eg20g(1),eg20(571)),(eg20h(1),eg20(666)),
* (eg20i(1),eg20(761)),(eg20j(1),eg20(856)),
* (eg20k(1),eg20(951)),(eg20l(1),eg20(1046)),
* (eg20m(1),eg20(1141)),(eg20n(1),eg20(1236)),
* (eg20o(1),eg20(1331)),(eg20p(1),eg20(1426)),
* (eg20q(1),eg20(1521)),(eg20r(1),eg20(1616)),
* (eg20s(1),eg20(1711)),(eg20t(1),eg20(1806)),
* (eg20u(1),eg20(1901))
equivalence (eg21a(1),eg21(1)),(eg21b(1),eg21(96)),
* (eg21c(1),eg21(191)),(eg21d(1),eg21(286))
equivalence (eg22a(1),eg22(1)),(eg22b(1),eg22(96))
equivalence (eg23a(1),eg23(1)),(eg23b(1),eg23(96))
*b groupr.1470
data eg19/
&1.000010d-05,1.000000d-01,5.400000d-01,4.000000d+00,8.315287d+00,
&1.370959d+01,2.260329d+01,4.016900d+01,6.790405d+01,9.166088d+01,
&1.486254d+02,3.043248d+02,4.539993d+02,7.485183d+02,1.234098d+03,
&2.034684d+03,3.354626d+03,5.530844d+03,9.118820d+03,1.503439d+04,
&2.478752d+04,4.086771d+04,6.737947d+04,1.110900d+05,1.831564d+05,
&3.019738d+05,4.978707d+05,8.208500d+05,1.353353d+06,2.231302d+06,
&3.678794d+06,6.065307d+06,1.000000d+07,1.964033d+07/
data eg20a/
&1.000010d-05,3.000000d-03,5.000000d-03,6.900000d-03,1.000000d-02,
&1.500000d-02,2.000000d-02,2.500000d-02,3.000000d-02,3.500000d-02,
&4.200000d-02,5.000000d-02,5.800000d-02,6.700000d-02,7.700000d-02,
&8.000000d-02,9.500000d-02,1.000000d-01,1.150000d-01,1.340000d-01,
&1.400000d-01,1.463700d-01,1.530300d-01,1.600000d-01,1.697100d-01,
&1.800000d-01,1.890000d-01,1.988100d-01,2.091400d-01,2.200000d-01,
&2.335800d-01,2.480000d-01,2.635100d-01,2.800000d-01,3.000000d-01,
&3.145000d-01,3.200000d-01,3.346600d-01,3.500000d-01,3.699300d-01,
&3.910000d-01,4.000000d-01,4.139900d-01,4.330000d-01,4.496800d-01,
&4.670100d-01,4.850000d-01,5.000000d-01,5.196200d-01,5.315800d-01,
&5.400000d-01,5.669600d-01,5.952800d-01,6.250000d-01,6.531500d-01,
&6.825600d-01,7.050000d-01,7.415500d-01,7.800000d-01,7.900000d-01,
&8.194500d-01,8.500000d-01,8.600000d-01,8.764250d-01,9.100000d-01,
&9.300000d-01,9.500000d-01,9.720000d-01,9.860000d-01,9.960000d-01,
&1.020000d+00,1.035000d+00,1.045000d+00,1.071000d+00,1.080000d+00,
&1.097000d+00,1.110000d+00,1.123000d+00,1.150000d+00,1.170000d+00,
&1.202060d+00,1.235000d+00,1.267080d+00,1.300000d+00,1.337500d+00,
&1.370000d+00,1.404560d+00,1.440000d+00,1.475000d+00,1.500000d+00,
&1.544340d+00,1.590000d+00,1.629510d+00,1.670000d+00,1.711970d+00/
data eg20b/
&1.755000d+00,1.797000d+00,1.840000d+00,1.855390d+00,1.884460d+00,
&1.930000d+00,1.974490d+00,2.020000d+00,2.059610d+00,2.100000d+00,
&2.130000d+00,2.185310d+00,2.242050d+00,2.300270d+00,2.360000d+00,
&2.382370d+00,2.421710d+00,2.485030d+00,2.550000d+00,2.600000d+00,
&2.659320d+00,2.720000d+00,2.767920d+00,2.837990d+00,2.909830d+00,
&2.983490d+00,3.059020d+00,3.137330d+00,3.217630d+00,3.300000d+00,
&3.380750d+00,3.466330d+00,3.554080d+00,3.644050d+00,3.736300d+00,
&3.830880d+00,3.927860d+00,4.000000d+00,4.129250d+00,4.233782d+00,
&4.340961d+00,4.450853d+00,4.563526d+00,4.679053d+00,4.797503d+00,
&4.918953d+00,5.043477d+00,5.085681d+00,5.128239d+00,5.171153d+00,
&5.214426d+00,5.258061d+00,5.302061d+00,5.346430d+00,5.391169d+00,
&5.436284d+00,5.481775d+00,5.527647d+00,5.573904d+00,5.620547d+00,
&5.667581d+00,5.715008d+00,5.762832d+00,5.811056d+00,5.859684d+00,
&5.908719d+00,5.958164d+00,6.008022d+00,6.058298d+00,6.108995d+00,
&6.160116d+00,6.211665d+00,6.263645d+00,6.316060d+00,6.368914d+00,
&6.422210d+00,6.475952d+00,6.530144d+00,6.584789d+00,6.639892d+00,
&6.695455d+00,6.751484d+00,6.807981d+00,6.864952d+00,6.922399d+00,
&6.980326d+00,7.038739d+00,7.097640d+00,7.157034d+00,7.216925d+00,
&7.277317d+00,7.338215d+00,7.399622d+00,7.461544d+00,7.523983d+00/
data eg20c/
&7.586945d+00,7.650434d+00,7.714454d+00,7.779009d+00,7.844105d+00,
&7.909746d+00,7.975936d+00,8.042680d+00,8.109982d+00,8.177848d+00,
&8.246281d+00,8.315287d+00,8.384871d+00,8.455037d+00,8.525790d+00,
&8.597135d+00,8.669077d+00,8.741621d+00,8.814772d+00,8.888536d+00,
&8.962916d+00,9.037919d+00,9.113550d+00,9.189814d+00,9.266715d+00,
&9.344261d+00,9.422455d+00,9.501303d+00,9.580812d+00,9.660985d+00,
&9.741830d+00,9.823351d+00,9.905554d+00,9.988446d+00,1.007203d+01,
&1.015631d+01,1.024130d+01,1.032701d+01,1.041342d+01,1.050056d+01,
&1.058843d+01,1.067704d+01,1.076639d+01,1.085648d+01,1.094733d+01,
&1.103894d+01,1.113132d+01,1.122446d+01,1.131839d+01,1.141311d+01,
&1.150861d+01,1.160492d+01,1.170203d+01,1.179995d+01,1.189870d+01,
&1.199827d+01,1.209867d+01,1.219991d+01,1.230201d+01,1.240495d+01,
&1.250876d+01,1.261343d+01,1.271898d+01,1.282542d+01,1.293274d+01,
&1.304097d+01,1.315010d+01,1.326014d+01,1.337110d+01,1.348299d+01,
&1.359582d+01,1.370959d+01,1.382431d+01,1.394000d+01,1.405665d+01,
&1.417428d+01,1.429289d+01,1.441250d+01,1.453310d+01,1.465472d+01,
&1.477735d+01,1.490101d+01,1.502570d+01,1.515144d+01,1.527823d+01,
&1.540608d+01,1.553500d+01,1.566500d+01,1.579609d+01,1.592827d+01,
&1.606156d+01,1.619597d+01,1.633150d+01,1.646816d+01,1.660597d+01/
data eg20d/
&1.674493d+01,1.688506d+01,1.702635d+01,1.716883d+01,1.731250d+01,
&1.745738d+01,1.760346d+01,1.775077d+01,1.789931d+01,1.804910d+01,
&1.820013d+01,1.835244d+01,1.850601d+01,1.866087d+01,1.881703d+01,
&1.897449d+01,1.913328d+01,1.929339d+01,1.945484d+01,1.961764d+01,
&1.978180d+01,1.994734d+01,2.011426d+01,2.028258d+01,2.045231d+01,
&2.062345d+01,2.079603d+01,2.097006d+01,2.114554d+01,2.132249d+01,
&2.150092d+01,2.168084d+01,2.186227d+01,2.204522d+01,2.222969d+01,
&2.241572d+01,2.260329d+01,2.279244d+01,2.298317d+01,2.317550d+01,
&2.336944d+01,2.356499d+01,2.376219d+01,2.396104d+01,2.416154d+01,
&2.436373d+01,2.456761d+01,2.477320d+01,2.498050d+01,2.518954d+01,
&2.540033d+01,2.561289d+01,2.582722d+01,2.604335d+01,2.626128d+01,
&2.648104d+01,2.670264d+01,2.692609d+01,2.715141d+01,2.737862d+01,
&2.760773d+01,2.783875d+01,2.807171d+01,2.830662d+01,2.854349d+01,
&2.878235d+01,2.902320d+01,2.926607d+01,2.951098d+01,2.975793d+01,
&3.000695d+01,3.025805d+01,3.051126d+01,3.076658d+01,3.102404d+01,
&3.128365d+01,3.154544d+01,3.180942d+01,3.207560d+01,3.234401d+01,
&3.261467d+01,3.288760d+01,3.316281d+01,3.344032d+01,3.372015d+01,
&3.400233d+01,3.428686d+01,3.457378d+01,3.486310d+01,3.515484d+01,
&3.544902d+01,3.574566d+01,3.604479d+01,3.634642d+01,3.665057d+01/
data eg20e/
&3.695727d+01,3.726653d+01,3.757838d+01,3.789285d+01,3.820994d+01,
&3.852969d+01,3.885211d+01,3.917723d+01,3.950507d+01,3.983565d+01,
&4.016900d+01,4.050514d+01,4.084410d+01,4.118589d+01,4.153054d+01,
&4.187807d+01,4.222851d+01,4.258189d+01,4.293822d+01,4.329753d+01,
&4.365985d+01,4.402521d+01,4.439361d+01,4.476511d+01,4.513971d+01,
&4.551744d+01,4.589834d+01,4.628243d+01,4.666972d+01,4.706026d+01,
&4.745407d+01,4.785117d+01,4.825160d+01,4.865538d+01,4.906253d+01,
&4.947309d+01,4.988709d+01,5.030456d+01,5.072551d+01,5.114999d+01,
&5.157802d+01,5.200963d+01,5.244486d+01,5.288373d+01,5.332626d+01,
&5.377251d+01,5.422248d+01,5.467623d+01,5.513376d+01,5.559513d+01,
&5.606036d+01,5.652948d+01,5.700253d+01,5.747954d+01,5.796053d+01,
&5.844556d+01,5.893464d+01,5.942781d+01,5.992511d+01,6.042657d+01,
&6.093223d+01,6.144212d+01,6.195628d+01,6.247474d+01,6.299754d+01,
&6.352471d+01,6.405630d+01,6.459233d+01,6.513285d+01,6.567789d+01,
&6.622749d+01,6.678169d+01,6.734053d+01,6.790405d+01,6.847228d+01,
&6.904527d+01,6.962305d+01,7.020566d+01,7.079316d+01,7.138556d+01,
&7.198293d+01,7.258529d+01,7.319270d+01,7.380518d+01,7.442280d+01,
&7.504558d+01,7.567357d+01,7.630682d+01,7.694537d+01,7.758926d+01,
&7.823854d+01,7.889325d+01,7.955344d+01,8.021915d+01,8.089044d+01/
data eg20f/
&8.156734d+01,8.224991d+01,8.293819d+01,8.363223d+01,8.433208d+01,
&8.503778d+01,8.574939d+01,8.646695d+01,8.719052d+01,8.792015d+01,
&8.865588d+01,8.939776d+01,9.014586d+01,9.090021d+01,9.166088d+01,
&9.242791d+01,9.320136d+01,9.398128d+01,9.476773d+01,9.556076d+01,
&9.636043d+01,9.716679d+01,9.797990d+01,9.879981d+01,9.962658d+01,
&1.004603d+02,1.013009d+02,1.021486d+02,1.030034d+02,1.038654d+02,
&1.047345d+02,1.056110d+02,1.064947d+02,1.073859d+02,1.082845d+02,
&1.091907d+02,1.101044d+02,1.110258d+02,1.119548d+02,1.128917d+02,
&1.138364d+02,1.147890d+02,1.157496d+02,1.167182d+02,1.176949d+02,
&1.186798d+02,1.196729d+02,1.206744d+02,1.216842d+02,1.227024d+02,
&1.237292d+02,1.247646d+02,1.258087d+02,1.268615d+02,1.279231d+02,
&1.289935d+02,1.300730d+02,1.311615d+02,1.322590d+02,1.333658d+02,
&1.344818d+02,1.356072d+02,1.367420d+02,1.378862d+02,1.390401d+02,
&1.402036d+02,1.413768d+02,1.425599d+02,1.437529d+02,1.449558d+02,
&1.461688d+02,1.473920d+02,1.486254d+02,1.498691d+02,1.511232d+02,
&1.523879d+02,1.536631d+02,1.549489d+02,1.562456d+02,1.575531d+02,
&1.588715d+02,1.602010d+02,1.615415d+02,1.628933d+02,1.642565d+02,
&1.656310d+02,1.670170d+02,1.684146d+02,1.698239d+02,1.712451d+02,
&1.726781d+02,1.741231d+02,1.755802d+02,1.770494d+02,1.785310d+02/
data eg20g/
&1.800250d+02,1.815315d+02,1.830505d+02,1.845823d+02,1.861269d+02,
&1.876845d+02,1.892551d+02,1.908388d+02,1.924358d+02,1.940461d+02,
&1.956699d+02,1.973073d+02,1.989584d+02,2.006233d+02,2.023021d+02,
&2.039950d+02,2.057021d+02,2.074234d+02,2.091592d+02,2.109095d+02,
&2.126744d+02,2.144541d+02,2.162487d+02,2.180583d+02,2.198830d+02,
&2.217230d+02,2.235784d+02,2.254494d+02,2.273360d+02,2.292384d+02,
&2.311567d+02,2.330910d+02,2.350416d+02,2.370084d+02,2.389917d+02,
&2.409917d+02,2.430083d+02,2.450418d+02,2.470924d+02,2.491601d+02,
&2.512451d+02,2.533476d+02,2.554676d+02,2.576054d+02,2.597611d+02,
&2.619348d+02,2.641267d+02,2.663370d+02,2.685657d+02,2.708131d+02,
&2.730793d+02,2.753645d+02,2.776688d+02,2.799924d+02,2.823354d+02,
&2.846980d+02,2.870804d+02,2.894827d+02,2.919052d+02,2.943479d+02,
&2.968110d+02,2.992948d+02,3.017993d+02,3.043248d+02,3.068715d+02,
&3.094394d+02,3.120288d+02,3.146399d+02,3.172729d+02,3.199279d+02,
&3.226051d+02,3.253047d+02,3.280269d+02,3.307719d+02,3.335398d+02,
&3.363309d+02,3.391454d+02,3.419834d+02,3.448452d+02,3.477309d+02,
&3.506408d+02,3.535750d+02,3.565338d+02,3.595173d+02,3.625258d+02,
&3.655595d+02,3.686185d+02,3.717032d+02,3.748137d+02,3.779502d+02,
&3.811129d+02,3.843021d+02,3.875180d+02,3.907608d+02,3.940308d+02/
data eg20h/
&3.973281d+02,4.006530d+02,4.040057d+02,4.073865d+02,4.107955d+02,
&4.142332d+02,4.176995d+02,4.211949d+02,4.247195d+02,4.282736d+02,
&4.318575d+02,4.354713d+02,4.391154d+02,4.427900d+02,4.464953d+02,
&4.502317d+02,4.539993d+02,4.577984d+02,4.616294d+02,4.654923d+02,
&4.693877d+02,4.733156d+02,4.772763d+02,4.812703d+02,4.852976d+02,
&4.893587d+02,4.934537d+02,4.975830d+02,5.017468d+02,5.059455d+02,
&5.101793d+02,5.144486d+02,5.187536d+02,5.230946d+02,5.274719d+02,
&5.318859d+02,5.363368d+02,5.408249d+02,5.453506d+02,5.499142d+02,
&5.545160d+02,5.591563d+02,5.638354d+02,5.685536d+02,5.733114d+02,
&5.781089d+02,5.829466d+02,5.878248d+02,5.927438d+02,5.977040d+02,
&6.027057d+02,6.077492d+02,6.128350d+02,6.179633d+02,6.231345d+02,
&6.283489d+02,6.336071d+02,6.389092d+02,6.442557d+02,6.496469d+02,
&6.550832d+02,6.605651d+02,6.660928d+02,6.716668d+02,6.772874d+02,
&6.829550d+02,6.886701d+02,6.944330d+02,7.002441d+02,7.061038d+02,
&7.120126d+02,7.179709d+02,7.239790d+02,7.300373d+02,7.361464d+02,
&7.423066d+02,7.485183d+02,7.547820d+02,7.610981d+02,7.674671d+02,
&7.738894d+02,7.803654d+02,7.868957d+02,7.934805d+02,8.001205d+02,
&8.068160d+02,8.135676d+02,8.203756d+02,8.272407d+02,8.341631d+02,
&8.411435d+02,8.481824d+02,8.552801d+02,8.624372d+02,8.696542d+02/
data eg20i/
&8.769316d+02,8.842699d+02,8.916696d+02,8.991312d+02,9.066553d+02,
&9.142423d+02,9.218928d+02,9.296074d+02,9.373865d+02,9.452307d+02,
&9.531405d+02,9.611165d+02,9.691593d+02,9.772694d+02,9.854473d+02,
&9.936937d+02,1.002009d+03,1.010394d+03,1.018849d+03,1.027375d+03,
&1.035972d+03,1.044641d+03,1.053383d+03,1.062198d+03,1.071087d+03,
&1.080050d+03,1.089088d+03,1.098201d+03,1.107391d+03,1.116658d+03,
&1.126002d+03,1.135425d+03,1.144926d+03,1.154507d+03,1.164168d+03,
&1.173910d+03,1.183734d+03,1.193639d+03,1.203628d+03,1.213700d+03,
&1.223857d+03,1.234098d+03,1.244425d+03,1.254839d+03,1.265339d+03,
&1.275928d+03,1.286605d+03,1.297372d+03,1.308228d+03,1.319176d+03,
&1.330215d+03,1.341346d+03,1.352571d+03,1.363889d+03,1.375303d+03,
&1.386811d+03,1.398416d+03,1.410118d+03,1.421919d+03,1.433817d+03,
&1.445816d+03,1.457915d+03,1.470115d+03,1.482417d+03,1.494822d+03,
&1.507331d+03,1.519944d+03,1.532663d+03,1.545489d+03,1.558422d+03,
&1.571463d+03,1.584613d+03,1.597874d+03,1.611245d+03,1.624728d+03,
&1.638324d+03,1.652034d+03,1.665858d+03,1.679798d+03,1.693855d+03,
&1.708030d+03,1.722323d+03,1.736735d+03,1.751268d+03,1.765923d+03,
&1.780701d+03,1.795602d+03,1.810628d+03,1.825780d+03,1.841058d+03,
&1.856464d+03,1.871999d+03,1.887665d+03,1.903461d+03,1.919389d+03/
data eg20j/
&1.935451d+03,1.951647d+03,1.967979d+03,1.984447d+03,2.001053d+03,
&2.017798d+03,2.034684d+03,2.051710d+03,2.068879d+03,2.086192d+03,
&2.103650d+03,2.121253d+03,2.139004d+03,2.156904d+03,2.174953d+03,
&2.193153d+03,2.211506d+03,2.230012d+03,2.248673d+03,2.267490d+03,
&2.286465d+03,2.305599d+03,2.324892d+03,2.344347d+03,2.363965d+03,
&2.383747d+03,2.403695d+03,2.423809d+03,2.444092d+03,2.464545d+03,
&2.485168d+03,2.505965d+03,2.526935d+03,2.548081d+03,2.569403d+03,
&2.590904d+03,2.612586d+03,2.634448d+03,2.656494d+03,2.678723d+03,
&2.701139d+03,2.723743d+03,2.746536d+03,2.769519d+03,2.792695d+03,
&2.816065d+03,2.839630d+03,2.863392d+03,2.887354d+03,2.911515d+03,
&2.935879d+03,2.960447d+03,2.985221d+03,3.010202d+03,3.035391d+03,
&3.060792d+03,3.086405d+03,3.112233d+03,3.138276d+03,3.164538d+03,
&3.191019d+03,3.217722d+03,3.244649d+03,3.271800d+03,3.299179d+03,
&3.326787d+03,3.354626d+03,3.382698d+03,3.411005d+03,3.439549d+03,
&3.468332d+03,3.497355d+03,3.526622d+03,3.556133d+03,3.585891d+03,
&3.615898d+03,3.646157d+03,3.676668d+03,3.707435d+03,3.738460d+03,
&3.769744d+03,3.801290d+03,3.833099d+03,3.865175d+03,3.897520d+03,
&3.930135d+03,3.963023d+03,3.996186d+03,4.029627d+03,4.063347d+03,
&4.097350d+03,4.131637d+03,4.166211d+03,4.201075d+03,4.236230d+03/
data eg20k/
&4.271679d+03,4.307425d+03,4.343471d+03,4.379817d+03,4.416468d+03,
&4.453426d+03,4.490693d+03,4.528272d+03,4.566165d+03,4.604375d+03,
&4.642906d+03,4.681758d+03,4.720936d+03,4.760441d+03,4.800277d+03,
&4.840447d+03,4.880952d+03,4.921797d+03,4.962983d+03,5.004514d+03,
&5.046393d+03,5.088622d+03,5.131204d+03,5.174143d+03,5.217441d+03,
&5.261101d+03,5.305127d+03,5.349521d+03,5.394287d+03,5.439427d+03,
&5.484945d+03,5.530844d+03,5.577127d+03,5.623797d+03,5.670858d+03,
&5.718312d+03,5.766164d+03,5.814416d+03,5.863072d+03,5.912135d+03,
&5.961609d+03,6.011496d+03,6.061802d+03,6.112528d+03,6.163678d+03,
&6.215257d+03,6.267267d+03,6.319712d+03,6.372597d+03,6.425924d+03,
&6.479697d+03,6.533920d+03,6.588597d+03,6.643731d+03,6.699327d+03,
&6.755388d+03,6.811918d+03,6.868921d+03,6.926401d+03,6.984362d+03,
&7.042809d+03,7.101744d+03,7.161172d+03,7.221098d+03,7.281525d+03,
&7.342458d+03,7.403901d+03,7.465858d+03,7.528334d+03,7.591332d+03,
&7.654857d+03,7.718914d+03,7.783507d+03,7.848641d+03,7.914319d+03,
&7.980548d+03,8.047330d+03,8.114671d+03,8.182576d+03,8.251049d+03,
&8.320095d+03,8.389719d+03,8.459926d+03,8.530719d+03,8.602106d+03,
&8.674090d+03,8.746676d+03,8.819869d+03,8.893675d+03,8.968099d+03,
&9.043145d+03,9.118820d+03,9.195127d+03,9.272074d+03,9.349664d+03/
data eg20l/
&9.427903d+03,9.506797d+03,9.586352d+03,9.666572d+03,9.747463d+03,
&9.829031d+03,9.911282d+03,9.994221d+03,1.007785d+04,1.016219d+04,
&1.024723d+04,1.033298d+04,1.041944d+04,1.050664d+04,1.059456d+04,
&1.068321d+04,1.077261d+04,1.086276d+04,1.095366d+04,1.104532d+04,
&1.113775d+04,1.123095d+04,1.132494d+04,1.141970d+04,1.151527d+04,
&1.161163d+04,1.170880d+04,1.180678d+04,1.190558d+04,1.200521d+04,
&1.210567d+04,1.220697d+04,1.230912d+04,1.241212d+04,1.251599d+04,
&1.262073d+04,1.272634d+04,1.283283d+04,1.294022d+04,1.304851d+04,
&1.315770d+04,1.326780d+04,1.337883d+04,1.349079d+04,1.360368d+04,
&1.371752d+04,1.383231d+04,1.394806d+04,1.406478d+04,1.418247d+04,
&1.430116d+04,1.442083d+04,1.454151d+04,1.466319d+04,1.478590d+04,
&1.490963d+04,1.503439d+04,1.516020d+04,1.528706d+04,1.541499d+04,
&1.554398d+04,1.567406d+04,1.580522d+04,1.593748d+04,1.607085d+04,
&1.620533d+04,1.634094d+04,1.647768d+04,1.661557d+04,1.675461d+04,
&1.689482d+04,1.703620d+04,1.717876d+04,1.732251d+04,1.746747d+04,
&1.761364d+04,1.776104d+04,1.790966d+04,1.805953d+04,1.821066d+04,
&1.836305d+04,1.851671d+04,1.867166d+04,1.882791d+04,1.898547d+04,
&1.914434d+04,1.930454d+04,1.946608d+04,1.962898d+04,1.979324d+04,
&1.995887d+04,2.012589d+04,2.029431d+04,2.046413d+04,2.063538d+04/
data eg20m/
&2.080806d+04,2.098218d+04,2.115777d+04,2.133482d+04,2.151335d+04,
&2.169338d+04,2.187491d+04,2.205796d+04,2.224255d+04,2.242868d+04,
&2.261636d+04,2.280562d+04,2.299646d+04,2.318890d+04,2.338295d+04,
&2.357862d+04,2.377593d+04,2.397489d+04,2.417552d+04,2.437782d+04,
&2.458182d+04,2.478752d+04,2.499495d+04,2.520411d+04,2.541502d+04,
&2.562770d+04,2.584215d+04,2.605841d+04,2.627647d+04,2.649635d+04,
&2.671808d+04,2.694166d+04,2.700000d+04,2.716711d+04,2.739445d+04,
&2.762369d+04,2.785485d+04,2.808794d+04,2.832299d+04,2.850000d+04,
&2.856000d+04,2.879899d+04,2.903999d+04,2.928300d+04,2.952804d+04,
&2.977514d+04,3.002430d+04,3.027555d+04,3.052890d+04,3.078437d+04,
&3.104198d+04,3.130174d+04,3.156368d+04,3.182781d+04,3.209415d+04,
&3.236272d+04,3.263353d+04,3.290662d+04,3.318198d+04,3.345965d+04,
&3.373965d+04,3.402199d+04,3.430669d+04,3.459377d+04,3.488326d+04,
&3.517517d+04,3.546952d+04,3.576633d+04,3.606563d+04,3.636743d+04,
&3.667176d+04,3.697864d+04,3.728808d+04,3.760011d+04,3.791476d+04,
&3.823203d+04,3.855196d+04,3.887457d+04,3.919988d+04,3.952791d+04,
&3.985869d+04,4.019223d+04,4.052857d+04,4.086771d+04,4.120970d+04,
&4.155455d+04,4.190229d+04,4.225293d+04,4.260651d+04,4.296305d+04,
&4.332257d+04,4.368510d+04,4.405066d+04,4.441928d+04,4.479099d+04/
data eg20n/
&4.516581d+04,4.554376d+04,4.592488d+04,4.630919d+04,4.669671d+04,
&4.708747d+04,4.748151d+04,4.787884d+04,4.827950d+04,4.868351d+04,
&4.909090d+04,4.950170d+04,4.991594d+04,5.033364d+04,5.075484d+04,
&5.117957d+04,5.160785d+04,5.203971d+04,5.247518d+04,5.291430d+04,
&5.335710d+04,5.380360d+04,5.425384d+04,5.470784d+04,5.516564d+04,
&5.562728d+04,5.609278d+04,5.656217d+04,5.703549d+04,5.751277d+04,
&5.799405d+04,5.847935d+04,5.896871d+04,5.946217d+04,5.995976d+04,
&6.046151d+04,6.096747d+04,6.147765d+04,6.199211d+04,6.251086d+04,
&6.303396d+04,6.356144d+04,6.409333d+04,6.462968d+04,6.517051d+04,
&6.571586d+04,6.626579d+04,6.682031d+04,6.737947d+04,6.794331d+04,
&6.851187d+04,6.908519d+04,6.966330d+04,7.024626d+04,7.083409d+04,
&7.142684d+04,7.202455d+04,7.262726d+04,7.323502d+04,7.384786d+04,
&7.446583d+04,7.508897d+04,7.571733d+04,7.635094d+04,7.698986d+04,
&7.763412d+04,7.828378d+04,7.893887d+04,7.950000d+04,7.959944d+04,
&8.026554d+04,8.093721d+04,8.161451d+04,8.229747d+04,8.250000d+04,
&8.298615d+04,8.368059d+04,8.438084d+04,8.508695d+04,8.579897d+04,
&8.651695d+04,8.724094d+04,8.797098d+04,8.870714d+04,8.944945d+04,
&9.019798d+04,9.095277d+04,9.171388d+04,9.248135d+04,9.325525d+04,
&9.403563d+04,9.482253d+04,9.561602d+04,9.641615d+04,9.722297d+04/
data eg20o/
&9.803655d+04,9.885694d+04,9.968419d+04,1.005184d+05,1.013595d+05,
&1.022077d+05,1.030630d+05,1.039254d+05,1.047951d+05,1.056720d+05,
&1.065563d+05,1.074480d+05,1.083471d+05,1.092538d+05,1.101681d+05,
&1.110900d+05,1.120196d+05,1.129570d+05,1.139022d+05,1.148554d+05,
&1.158165d+05,1.167857d+05,1.177629d+05,1.187484d+05,1.197421d+05,
&1.207441d+05,1.217545d+05,1.227734d+05,1.238008d+05,1.248368d+05,
&1.258814d+05,1.269348d+05,1.279970d+05,1.290681d+05,1.301482d+05,
&1.312373d+05,1.323355d+05,1.334429d+05,1.345596d+05,1.356856d+05,
&1.368210d+05,1.379660d+05,1.391205d+05,1.402847d+05,1.414586d+05,
&1.426423d+05,1.438360d+05,1.450396d+05,1.462533d+05,1.474772d+05,
&1.487113d+05,1.499558d+05,1.512106d+05,1.524760d+05,1.537519d+05,
&1.550385d+05,1.563359d+05,1.576442d+05,1.589634d+05,1.602936d+05,
&1.616349d+05,1.629875d+05,1.643514d+05,1.657268d+05,1.671136d+05,
&1.685120d+05,1.699221d+05,1.713441d+05,1.727779d+05,1.742237d+05,
&1.756817d+05,1.771518d+05,1.786342d+05,1.801291d+05,1.816364d+05,
&1.831564d+05,1.846891d+05,1.862346d+05,1.877930d+05,1.893645d+05,
&1.909491d+05,1.925470d+05,1.941583d+05,1.957830d+05,1.974214d+05,
&1.990734d+05,2.007393d+05,2.024191d+05,2.041130d+05,2.058210d+05,
&2.075434d+05,2.092801d+05,2.110314d+05,2.127974d+05,2.145781d+05/
data eg20p/
&2.163737d+05,2.181844d+05,2.200102d+05,2.218512d+05,2.237077d+05,
&2.255797d+05,2.274674d+05,2.293709d+05,2.312903d+05,2.332258d+05,
&2.351775d+05,2.371455d+05,2.391299d+05,2.411310d+05,2.431488d+05,
&2.451835d+05,2.472353d+05,2.493042d+05,2.513904d+05,2.534941d+05,
&2.556153d+05,2.577544d+05,2.599113d+05,2.620863d+05,2.642794d+05,
&2.664910d+05,2.687210d+05,2.709697d+05,2.732372d+05,2.755237d+05,
&2.778293d+05,2.801543d+05,2.824986d+05,2.848626d+05,2.872464d+05,
&2.896501d+05,2.920740d+05,2.945181d+05,2.969826d+05,2.972000d+05,
&2.985000d+05,2.994678d+05,3.019738d+05,3.045008d+05,3.070489d+05,
&3.096183d+05,3.122093d+05,3.148219d+05,3.174564d+05,3.201129d+05,
&3.227916d+05,3.254928d+05,3.282166d+05,3.309631d+05,3.337327d+05,
&3.365254d+05,3.393415d+05,3.421812d+05,3.450446d+05,3.479320d+05,
&3.508435d+05,3.537795d+05,3.567399d+05,3.597252d+05,3.627354d+05,
&3.657708d+05,3.688317d+05,3.719181d+05,3.750304d+05,3.781687d+05,
&3.813333d+05,3.845243d+05,3.877421d+05,3.909868d+05,3.942586d+05,
&3.975578d+05,4.008846d+05,4.042393d+05,4.076220d+05,4.110331d+05,
&4.144727d+05,4.179410d+05,4.214384d+05,4.249651d+05,4.285213d+05,
&4.321072d+05,4.357231d+05,4.393693d+05,4.430460d+05,4.467535d+05,
&4.504920d+05,4.542618d+05,4.580631d+05,4.618963d+05,4.657615d+05/
data eg20q/
&4.696591d+05,4.735892d+05,4.775523d+05,4.815485d+05,4.855782d+05,
&4.896416d+05,4.937390d+05,4.978707d+05,5.020369d+05,5.062381d+05,
&5.104743d+05,5.147461d+05,5.190535d+05,5.233971d+05,5.277769d+05,
&5.321934d+05,5.366469d+05,5.411377d+05,5.456660d+05,5.502322d+05,
&5.548366d+05,5.594796d+05,5.641614d+05,5.688824d+05,5.736429d+05,
&5.784432d+05,5.832837d+05,5.881647d+05,5.930866d+05,5.980496d+05,
&6.030542d+05,6.081006d+05,6.131893d+05,6.183206d+05,6.234948d+05,
&6.287123d+05,6.339734d+05,6.392786d+05,6.446282d+05,6.500225d+05,
&6.554620d+05,6.609470d+05,6.664779d+05,6.720551d+05,6.776790d+05,
&6.833499d+05,6.890683d+05,6.948345d+05,7.006490d+05,7.065121d+05,
&7.124243d+05,7.183860d+05,7.243976d+05,7.304594d+05,7.365720d+05,
&7.427358d+05,7.489511d+05,7.552184d+05,7.615382d+05,7.679109d+05,
&7.743369d+05,7.808167d+05,7.873507d+05,7.939393d+05,8.005831d+05,
&8.072825d+05,8.140380d+05,8.208500d+05,8.277190d+05,8.346455d+05,
&8.416299d+05,8.486728d+05,8.557746d+05,8.629359d+05,8.701570d+05,
&8.774387d+05,8.847812d+05,8.921852d+05,8.996511d+05,9.071795d+05,
&9.147709d+05,9.224259d+05,9.301449d+05,9.379285d+05,9.457772d+05,
&9.536916d+05,9.616723d+05,9.697197d+05,9.778344d+05,9.860171d+05,
&9.942682d+05,1.002588d+06,1.010978d+06,1.019438d+06,1.027969d+06/
data eg20r/
&1.036571d+06,1.045245d+06,1.053992d+06,1.062812d+06,1.071706d+06,
&1.080674d+06,1.089717d+06,1.098836d+06,1.108032d+06,1.117304d+06,
&1.126654d+06,1.136082d+06,1.145588d+06,1.155175d+06,1.164842d+06,
&1.174589d+06,1.184418d+06,1.194330d+06,1.204324d+06,1.214402d+06,
&1.224564d+06,1.234812d+06,1.245145d+06,1.255564d+06,1.266071d+06,
&1.276666d+06,1.287349d+06,1.298122d+06,1.308985d+06,1.319938d+06,
&1.330984d+06,1.342122d+06,1.353353d+06,1.364678d+06,1.376098d+06,
&1.387613d+06,1.399225d+06,1.410934d+06,1.422741d+06,1.434646d+06,
&1.446652d+06,1.458758d+06,1.470965d+06,1.483274d+06,1.495686d+06,
&1.508202d+06,1.520823d+06,1.533550d+06,1.546383d+06,1.559323d+06,
&1.572372d+06,1.585530d+06,1.598797d+06,1.612176d+06,1.625667d+06,
&1.639271d+06,1.652989d+06,1.666821d+06,1.680770d+06,1.694834d+06,
&1.709017d+06,1.723318d+06,1.737739d+06,1.752281d+06,1.766944d+06,
&1.781731d+06,1.796640d+06,1.811675d+06,1.826835d+06,1.842122d+06,
&1.857538d+06,1.873082d+06,1.888756d+06,1.904561d+06,1.920499d+06,
&1.936570d+06,1.952776d+06,1.969117d+06,1.985595d+06,2.002210d+06,
&2.018965d+06,2.035860d+06,2.052897d+06,2.070076d+06,2.087398d+06,
&2.104866d+06,2.122480d+06,2.140241d+06,2.158151d+06,2.176211d+06,
&2.194421d+06,2.212785d+06,2.231302d+06,2.249973d+06,2.268802d+06/
data eg20s/
&2.287787d+06,2.306932d+06,2.326237d+06,2.345703d+06,2.365332d+06,
&2.385126d+06,2.405085d+06,2.425211d+06,2.445505d+06,2.465970d+06,
&2.486605d+06,2.507414d+06,2.528396d+06,2.549554d+06,2.570889d+06,
&2.592403d+06,2.614096d+06,2.635971d+06,2.658030d+06,2.680272d+06,
&2.702701d+06,2.725318d+06,2.748124d+06,2.771121d+06,2.794310d+06,
&2.817693d+06,2.841272d+06,2.865048d+06,2.889023d+06,2.913199d+06,
&2.937577d+06,2.962159d+06,2.986947d+06,3.011942d+06,3.037147d+06,
&3.062562d+06,3.088190d+06,3.114032d+06,3.140091d+06,3.166368d+06,
&3.192864d+06,3.219583d+06,3.246525d+06,3.273692d+06,3.301087d+06,
&3.328711d+06,3.356566d+06,3.384654d+06,3.412978d+06,3.441538d+06,
&3.470337d+06,3.499377d+06,3.528661d+06,3.558189d+06,3.587965d+06,
&3.617989d+06,3.648265d+06,3.678794d+06,3.709579d+06,3.740621d+06,
&3.771924d+06,3.803488d+06,3.835316d+06,3.867410d+06,3.899773d+06,
&3.932407d+06,3.965314d+06,3.998497d+06,4.031957d+06,4.065697d+06,
&4.099719d+06,4.134026d+06,4.168620d+06,4.203504d+06,4.238679d+06,
&4.274149d+06,4.309916d+06,4.345982d+06,4.382350d+06,4.419022d+06,
&4.456001d+06,4.493290d+06,4.530890d+06,4.568805d+06,4.607038d+06,
&4.645590d+06,4.684465d+06,4.723666d+06,4.763194d+06,4.803053d+06,
&4.843246d+06,4.883775d+06,4.924643d+06,4.965853d+06,5.007408d+06/
data eg20t/
&5.049311d+06,5.091564d+06,5.134171d+06,5.177135d+06,5.220458d+06,
&5.264143d+06,5.308195d+06,5.352614d+06,5.397406d+06,5.442572d+06,
&5.488116d+06,5.534042d+06,5.580351d+06,5.627049d+06,5.674137d+06,
&5.721619d+06,5.769498d+06,5.817778d+06,5.866462d+06,5.915554d+06,
&5.965056d+06,6.014972d+06,6.065307d+06,6.116062d+06,6.167242d+06,
&6.218851d+06,6.270891d+06,6.323367d+06,6.376282d+06,6.429639d+06,
&6.483443d+06,6.537698d+06,6.592406d+06,6.647573d+06,6.703200d+06,
&6.759294d+06,6.815857d+06,6.872893d+06,6.930406d+06,6.988401d+06,
&7.046881d+06,7.105850d+06,7.165313d+06,7.225274d+06,7.285736d+06,
&7.346704d+06,7.408182d+06,7.470175d+06,7.532687d+06,7.595721d+06,
&7.659283d+06,7.723377d+06,7.788008d+06,7.853179d+06,7.918896d+06,
&7.985162d+06,8.051983d+06,8.119363d+06,8.187308d+06,8.255820d+06,
&8.324906d+06,8.394570d+06,8.464817d+06,8.535652d+06,8.607080d+06,
&8.679105d+06,8.751733d+06,8.824969d+06,8.898818d+06,8.973284d+06,
&9.048374d+06,9.124092d+06,9.200444d+06,9.277435d+06,9.355070d+06,
&9.433354d+06,9.512294d+06,9.591895d+06,9.672161d+06,9.753099d+06,
&9.834715d+06,9.917013d+06,1.000000d+07,1.008368d+07,1.016806d+07,
&1.025315d+07,1.033895d+07,1.042547d+07,1.051271d+07,1.060068d+07,
&1.068939d+07,1.077884d+07,1.086904d+07,1.095999d+07,1.105171d+07/
data eg20u/
&1.114419d+07,1.123745d+07,1.133148d+07,1.142631d+07,1.152193d+07,
&1.161834d+07,1.171557d+07,1.181360d+07,1.191246d+07,1.201215d+07,
&1.211267d+07,1.221403d+07,1.231624d+07,1.241930d+07,1.252323d+07,
&1.262802d+07,1.273370d+07,1.284025d+07,1.294770d+07,1.305605d+07,
&1.316531d+07,1.327548d+07,1.338657d+07,1.349859d+07,1.361155d+07,
&1.372545d+07,1.384031d+07,1.395612d+07,1.407291d+07,1.419068d+07,
&1.430943d+07,1.442917d+07,1.454991d+07,1.467167d+07,1.479444d+07,
&1.491825d+07,1.504309d+07,1.516897d+07,1.529590d+07,1.542390d+07,
&1.555297d+07,1.568312d+07,1.581436d+07,1.594670d+07,1.608014d+07,
&1.621470d+07,1.635039d+07,1.648721d+07,1.662518d+07,1.676430d+07,
&1.690459d+07,1.704605d+07,1.718869d+07,1.733253d+07,1.747757d+07,
&1.762383d+07,1.777131d+07,1.792002d+07,1.806998d+07,1.822119d+07,
&1.837367d+07,1.852742d+07,1.868246d+07,1.883880d+07,1.899644d+07,
&1.915541d+07,1.931570d+07,1.947734d+07,1.964033d+07/
data eg21a/
&1.000010d-05,1.100000d-04,3.000000d-03,5.500100d-03,1.000000d-02,
&1.500000d-02,2.000000d-02,3.000000d-02,3.200000d-02,3.238000d-02,
&4.300000d-02,5.900100d-02,7.700100d-02,9.500000d-02,1.000000d-01,
&1.150000d-01,1.340000d-01,1.600000d-01,1.890000d-01,2.200000d-01,
&2.480000d-01,2.825000d-01,3.145000d-01,3.520000d-01,3.910100d-01,
&4.139900d-01,4.330000d-01,4.850100d-01,5.315800d-01,5.400100d-01,
&6.250100d-01,6.825600d-01,7.050000d-01,7.900100d-01,8.600100d-01,
&8.764200d-01,9.300100d-01,9.860100d-01,1.010000d+00,1.035000d+00,
&1.070000d+00,1.080000d+00,1.090000d+00,1.110000d+00,1.125400d+00,
&1.170000d+00,1.235000d+00,1.305000d+00,1.370000d+00,1.440000d+00,
&1.445000d+00,1.510000d+00,1.590000d+00,1.670000d+00,1.755000d+00,
&1.840000d+00,1.855400d+00,1.930000d+00,2.020000d+00,2.130000d+00,
&2.360000d+00,2.372400d+00,2.767900d+00,3.059000d+00,3.380700d+00,
&3.927900d+00,4.129200d+00,4.470000d+00,4.670000d+00,5.043500d+00,
&5.623000d+00,6.160100d+00,6.476000d+00,7.079000d+00,7.524000d+00,
&7.943000d+00,8.315300d+00,8.913000d+00,9.189800d+00,1.000000d+01,
&1.067700d+01,1.122400d+01,1.259000d+01,1.371000d+01,1.522700d+01,
&1.674500d+01,1.760300d+01,1.902800d+01,2.045200d+01,2.260300d+01,
&2.498000d+01,2.791800d+01,2.920300d+01,3.051100d+01,3.388900d+01/
data eg21b/
&3.726700d+01,3.981000d+01,4.551700d+01,4.785100d+01,5.012000d+01,
&5.559500d+01,6.144200d+01,6.310000d+01,6.790400d+01,7.079000d+01,
&7.889300d+01,8.527700d+01,9.166100d+01,1.013000d+02,1.122000d+02,
&1.300700d+02,1.367400d+02,1.585000d+02,1.670200d+02,1.778000d+02,
&2.039900d+02,2.144500d+02,2.430100d+02,2.753600d+02,3.043200d+02,
&3.535800d+02,3.981000d+02,4.540000d+02,5.144600d+02,5.829500d+02,
&6.310000d+02,6.772900d+02,7.079000d+02,7.485200d+02,8.482000d+02,
&9.611200d+02,1.010400d+03,1.116700d+03,1.234100d+03,1.363900d+03,
&1.507300d+03,1.584600d+03,1.795600d+03,2.034700d+03,2.113000d+03,
&2.248700d+03,2.371000d+03,2.485200d+03,2.612600d+03,2.661000d+03,
&2.746500d+03,2.818000d+03,3.035400d+03,3.162000d+03,3.354600d+03,
&3.548000d+03,3.707400d+03,3.981000d+03,4.307400d+03,4.642900d+03,
&5.004500d+03,5.530800d+03,6.267300d+03,7.101700d+03,7.465900d+03,
&8.251000d+03,9.118800d+03,1.007800d+04,1.113800d+04,1.170900d+04,
&1.272600d+04,1.383200d+04,1.503400d+04,1.585000d+04,1.661600d+04,
&1.778000d+04,1.930500d+04,1.995000d+04,2.054000d+04,2.113000d+04,
&2.187500d+04,2.239000d+04,2.304000d+04,2.357900d+04,2.417600d+04,
&2.441000d+04,2.478800d+04,2.512000d+04,2.585000d+04,2.605800d+04,
&2.661000d+04,2.700000d+04,2.738000d+04,2.818000d+04,2.850000d+04/
data eg21c/
&2.901000d+04,2.985000d+04,3.073000d+04,3.162000d+04,3.182800d+04,
&3.430700d+04,3.697900d+04,4.086800d+04,4.358900d+04,4.630900d+04,
&4.939200d+04,5.247500d+04,5.516600d+04,5.656200d+04,6.172500d+04,
&6.737900d+04,7.200000d+04,7.499000d+04,7.950000d+04,8.229700d+04,
&8.250000d+04,8.651700d+04,9.803700d+04,1.110900d+05,1.167900d+05,
&1.227700d+05,1.290700d+05,1.356900d+05,1.426400d+05,1.499600d+05,
&1.576400d+05,1.657300d+05,1.742200d+05,1.831600d+05,1.925500d+05,
&2.024200d+05,2.128000d+05,2.237100d+05,2.351800d+05,2.472400d+05,
&2.732400d+05,2.872500d+05,2.945200d+05,2.972000d+05,2.985000d+05,
&3.019700d+05,3.337300d+05,3.688300d+05,3.877400d+05,4.076200d+05,
&4.504900d+05,5.234000d+05,5.502300d+05,5.784400d+05,6.081000d+05,
&6.392800d+05,6.720600d+05,7.065100d+05,7.427400d+05,7.808200d+05,
&8.208500d+05,8.629400d+05,9.071800d+05,9.616400d+05,1.002600d+06,
&1.108000d+06,1.164800d+06,1.224600d+06,1.287300d+06,1.353400d+06,
&1.422700d+06,1.495700d+06,1.572400d+06,1.653000d+06,1.737700d+06,
&1.826800d+06,1.920500d+06,2.019000d+06,2.122500d+06,2.231300d+06,
&2.306900d+06,2.345700d+06,2.365300d+06,2.385200d+06,2.466000d+06,
&2.592400d+06,2.725300d+06,2.865000d+06,3.011900d+06,3.166400d+06,
&3.328700d+06,3.678800d+06,4.065700d+06,4.493300d+06,4.723700d+06/
data eg21d/
&4.965900d+06,5.220500d+06,5.488100d+06,5.769500d+06,6.065300d+06,
&6.376300d+06,6.592400d+06,6.703200d+06,7.046900d+06,7.408200d+06,
&7.788000d+06,8.187300d+06,8.607100d+06,9.048400d+06,9.512300d+06,
&1.000000d+07,1.051300d+07,1.105200d+07,1.161800d+07,1.221400d+07,
&1.284000d+07,1.349900d+07,1.384000d+07,1.419100d+07,1.455000d+07,
&1.491800d+07,1.568300d+07,1.648700d+07,1.690500d+07,1.733300d+07,
&1.964000d+07/
data eg22a/
&1.000010d-05,3.000000d-03,5.000000d-03,6.900000d-03,1.000000d-02,
&1.500000d-02,2.000000d-02,2.500000d-02,3.000000d-02,3.500000d-02,
&4.200000d-02,5.000000d-02,5.800000d-02,6.700000d-02,7.700000d-02,
&8.000000d-02,9.500000d-02,1.000000d-01,1.150000d-01,1.340000d-01,
&1.400000d-01,1.600000d-01,1.800000d-01,1.890000d-01,2.200000d-01,
&2.480000d-01,2.800000d-01,3.000000d-01,3.145000d-01,3.200000d-01,
&3.500000d-01,3.910000d-01,4.000000d-01,4.330000d-01,4.850000d-01,
&5.000000d-01,5.400000d-01,6.250000d-01,7.050000d-01,7.800000d-01,
&7.900000d-01,8.500000d-01,8.600000d-01,9.100000d-01,9.300000d-01,
&9.500000d-01,9.720000d-01,9.860000d-01,9.960000d-01,1.020000d+00,
&1.035000d+00,1.045000d+00,1.071000d+00,1.097000d+00,1.110000d+00,
&1.123000d+00,1.150000d+00,1.170000d+00,1.235000d+00,1.300000d+00,
&1.337500d+00,1.370000d+00,1.440000d+00,1.475000d+00,1.500000d+00,
&1.590000d+00,1.670000d+00,1.755000d+00,1.840000d+00,1.930000d+00,
&2.020000d+00,2.100000d+00,2.130000d+00,2.360000d+00,2.550000d+00,
&2.600000d+00,2.720000d+00,2.767920d+00,3.300000d+00,3.380750d+00,
&4.000000d+00,4.129250d+00,5.043477d+00,5.346430d+00,6.160116d+00,
&7.523983d+00,8.315287d+00,9.189814d+00,9.905554d+00,1.122446d+01,
&1.370959d+01,1.592827d+01,1.945484d+01,2.260329d+01,2.498050d+01/
data eg22b/
&2.760773d+01,3.051126d+01,3.372015d+01,3.726653d+01,4.016900d+01,
&4.551744d+01,4.825160d+01,5.157802d+01,5.559513d+01,6.790405d+01,
&7.567357d+01,9.166088d+01,1.367420d+02,1.486254d+02,2.039950d+02,
&3.043248d+02,3.717032d+02,4.539993d+02,6.772874d+02,7.485183d+02,
&9.142423d+02,1.010394d+03,1.234098d+03,1.433817d+03,1.507331d+03,
&2.034684d+03,2.248673d+03,3.354626d+03,3.526622d+03,5.004514d+03,
&5.530844d+03,7.465858d+03,9.118820d+03,1.113775d+04,1.503439d+04,
&1.661557d+04,2.478752d+04,2.739445d+04,2.928300d+04,3.697864d+04,
&4.086771d+04,5.516564d+04,6.737947d+04,8.229747d+04,1.110900d+05,
&1.227734d+05,1.831564d+05,2.472353d+05,2.732372d+05,3.019738d+05,
&4.076220d+05,4.504920d+05,4.978707d+05,5.502322d+05,6.081006d+05,
&8.208500d+05,9.071795d+05,1.002588d+06,1.108032d+06,1.224564d+06,
&1.353353d+06,1.652989d+06,2.018965d+06,2.231302d+06,2.465970d+06,
&3.011942d+06,3.678794d+06,4.493290d+06,5.488116d+06,6.065307d+06,
&6.703200d+06,8.187308d+06,1.000000d+07,1.1618343d+07,
&1.3840307d+07,1.4918247d+07,1.733253d+07,1.964033d+07/
data eg23a/
&1.000010d-05,1.000010d-01,4.139940d-01,5.315790d-01,6.825600d-01,
&8.764250d-01,1.123000d+00,1.440000d+00,1.855390d+00,2.382370d+00,
&3.059020d+00,3.927860d+00,5.043480d+00,6.475950d+00,8.315290d+00,
&1.067700d+01,1.370960d+01,1.760350d+01,2.260330d+01,2.902320d+01,
&3.726650d+01,4.785120d+01,6.144210d+01,7.889320d+01,1.013010d+02,
&1.300730d+02,1.670170d+02,2.144540d+02,2.753640d+02,3.535750d+02,
&4.539990d+02,5.829470d+02,7.485180d+02,9.611170d+02,1.234100d+03,
&1.584610d+03,2.034680d+03,2.248670d+03,2.485170d+03,2.612590d+03,
&2.746540d+03,3.035390d+03,3.354630d+03,3.707440d+03,4.307420d+03,
&5.530840d+03,7.101740d+03,9.118820d+03,1.059460d+04,1.170880d+04,
&1.503440d+04,1.930450d+04,2.187490d+04,2.357860d+04,2.417550d+04,
&2.478750d+04,2.605840d+04,2.700010d+04,2.850110d+04,3.182780d+04,
&3.430670d+04,4.086770d+04,4.630920d+04,5.247520d+04,5.656220d+04,
&6.737950d+04,7.202450d+04,7.949870d+04,8.250340d+04,8.651700d+04,
&9.803650d+04,1.110900d+05,1.167860d+05,1.227730d+05,1.290680d+05,
&1.356860d+05,1.426420d+05,1.499560d+05,1.576440d+05,1.657270d+05,
&1.742240d+05,1.831560d+05,1.925470d+05,2.024190d+05,2.127970d+05,
&2.237080d+05,2.351770d+05,2.472350d+05,2.732370d+05,2.872460d+05,
&2.945180d+05,2.972110d+05,2.984910d+05,3.019740d+05,3.337330d+05/
data eg23b/
&3.688320d+05,3.877420d+05,4.076220d+05,4.504920d+05,4.978710d+05,
&5.233970d+05,5.502320d+05,5.784430d+05,6.081010d+05,6.392790d+05,
&6.720550d+05,7.065120d+05,7.427360d+05,7.808170d+05,8.208500d+05,
&8.629360d+05,9.071800d+05,9.616720d+05,1.002590d+06,1.108030d+06,
&1.164840d+06,1.224560d+06,1.287350d+06,1.353350d+06,1.422740d+06,
&1.495690d+06,1.572370d+06,1.652990d+06,1.737740d+06,1.826840d+06,
&1.920500d+06,2.018970d+06,2.122480d+06,2.231300d+06,2.306930d+06,
&2.345700d+06,2.365330d+06,2.385130d+06,2.465970d+06,2.592400d+06,
&2.725320d+06,2.865050d+06,3.011940d+06,3.166370d+06,3.328710d+06,
&3.678790d+06,4.065700d+06,4.493290d+06,4.723670d+06,4.965850d+06,
&5.220460d+06,5.488120d+06,5.769500d+06,6.065310d+06,6.376280d+06,
&6.592410d+06,6.703200d+06,7.046880d+06,7.408180d+06,7.788010d+06,
&8.187310d+06,8.607080d+06,9.048370d+06,9.512290d+06,1.000000d+07,
&1.051270d+07,1.105170d+07,1.161830d+07,1.221400d+07,1.252320d+07,
&1.284030d+07,1.349860d+07,1.384030d+07,1.419070d+07,1.454990d+07,
&1.491820d+07,1.568310d+07,1.648720d+07,1.690460d+07,1.733250d+07,
&1.964030d+07/
*b groupr.1837
c
c ***ecco 33-group structure
else if (ign.eq.19) then
ng=33
do ig=1,34
eg(ig)=eg19(ig)
enddo
c
c ***ecco 1968-group structure
else if (ign.eq.20) then
ng=1968
do ig=1,1969
eg(ig)=eg20(ig)
enddo
c
c ***tripoli 315-group structure
else if (ign.eq.21) then
ng=315
do ig=1,316
eg(ig)=eg21(ig)
enddo
c
c ***xmas LWPC 172-group structure
else if (ign.eq.22) then
ng=172
do ig=1,173
eg(ig)=eg22(ig)
enddo
c
c ***vit-J LWPC 175-group structure
else if (ign.eq.23) then
ng=175
do ig=1,176
eg(ig)=eg23(ig)
enddo
*b groupr.1888
if (ign.eq.19) write(nsyso,'(/
& '' neutron group structure......ecco 33-group'')')
if (ign.eq.20) write(nsyso,'(/
& '' neutron group structure......ecco 1968-group'')')
if (ign.eq.21) write(nsyso,'(/
& '' neutron group structure......tripoli 315-group'')')
if (ign.eq.22) write(nsyso,'(/
& '' neutron group structure......xmas LWPC 172-group'')')
if (ign.eq.23) write(nsyso,'(/
& '' neutron group structure......vit-J LWPC 175-group'')')
*/
*/ increase the size of egn from 641 to 15000 i.e DICE 13193 APOLLO 11276
*/
*d groupr.1643
data ngmax/15000/
*d groupr.228
common/groupn/ign,ngn,egn(15000)
*d groupr.772
common/groupn/ign,ngn,egn(15000)
*d groupr.1303
common/groupn/ign,ng,eg(15000)
*d groupr.2643
common/groupn/ig,ngn,egn(15000)
*d groupr.3074
common/groupn/ign,ngn,egn(15000)
*d groupr.4274
common/groupn/ign,ngn,egn(15000)
*d groupr.6415
common/groupn/ign,ngn,egn(15000)
*d groupr.6918
common/groupn/ign,ngn,egn(15000)
*/
*ident wlup8x
*/ wimsr
*/ Prepare (n,2n) from MT=875-891 to correct absorption
*/ D. L. Aldama, NDS/IAEA Consultant, 2005
*/
*i wimsr.895
jn2n=0
*i wimsr.984
if (mth.eq.16) jn2n=16
*i wimsr.985
if ((mth.ge.875.and.mth.le.891).and.(jn2n.ne.16)) go to 236
*/
*ident ads01
*/ matxsr - D. L. Aldama, NDS/IAEA Consultant, July 2005
*/ Need more space (for processing ORNL 421 energy group structure)
*/ subroutine vector
*d up88.21
dimension b(30000)
*d up88.23
maxb=30000
*ident ads02
*/ matxsr - D. L. Aldama, NDS/IAEA Consultant, July 2005
*/ Remove a problem in case of multi-temperature matxs files processing.
*/ Scratch tapes iref and nscr should be simultaneously forwarded.
*/ The problem seems to affect only multi-temperature runs, if the mf=6
*/ of gendf tape was not ordered by mt numbers.
*/
*i matxsr.1870
if (iref.ne.0) call contio(iref,0,0,b(1),nb,nw)
*d matxsr.1878
if (iskip.eq.0) then
if (iref.ne.0) call tosend(iref,0,0,b(1))
call tosend(nscr,0,0,b(1))
endif
*/
*ident ads03
*/ acer - D. L. Aldama, NDS/IAEA Consultant, July 2005
*/ need more storage for processing jeff-3.1 U-238
*/ ADS library
*/
*d up57.76
max3=4000000
*d up57.78
common/xsst/xss(4000000),n3
*d up57.80
common/xsst/xss(4000000),n3
*d up57.82
common/xsst/xss(4000000),n3
*d up57.84
common/xsst/xss(4000000),n3
*d up57.86
common/xsst/xss(4000000),n3
*d up57.88
common/xsst/xss(4000000),n3
*d up57.90
common/xsst/xss(4000000),n3
*d up57.92
common/xsst/xss(4000000),n3
*d up57.94
common/xsst/xss(4000000),n3
*d up57.96
common/xsst/xss(4000000),n3
*d up57.98
common/xsst/xss(4000000),n3
*d up57.100
common/xsst/xss(4000000),n3
*d up57.102
common/xsst/xss(4000000),n3
*d up57.104
common/xsst/xss(4000000),n3
*d up57.106
common/xsst/xss(4000000),n3
*d up57.108
common/xsst/xss(4000000),n3
*d up57.110
common/xsst/xss(4000000),n3
*d up57.112
common/xsst/xss(4000000),n3
*d up57.114
common/xsst/xss(4000000),n3
*d up57.116
common/xsst/xss(4000000),n3
*d up57.118
common/xsst/xss(4000000),n3
*d up57.120
common/xsst/xss(4000000),n3
*d up57.122
common/xsst/xss(4000000),n3
*d up57.124
common/xsst/xss(4000000),n3
*d up57.126
common/xsst/xss(4000000),n3
*d up57.128
common/xsst/xss(4000000),n3
*d up57.130
common/xsst/xss(4000000),n3
*d up57.132
common/xsst/xss(4000000),n3
*d up57.134
common/xsst/xss(4000000),n3
*d up57.136
common/xsst/xss(4000000),n3
*d up57.138
common/xsst/xss(4000000),n3
*d up57.140
common/xsst/xss(4000000),n3
*d up57.142
common/xsst/xss(4000000),n3
*d up70.95
common/xsst/xss(4000000),n3
*d up57.144
common/xsst/xss(4000000),n3
*d up70.222
common/xsst/xss(4000000),n3
*d up57.146
common/xsst/xss(4000000),n3
*d up57.148
common/xsst/xss(4000000),n3
*d up57.150
common/xsst/xss(4000000),n3
*/