*cpl all *npl */ Activate *noid command on Linux g77 compiler */noid */ */ ------------------------------------------------------------- */ General WIMSD-5B updates to remove machine-dependent features */ and all calls to the Winfrith SYSCALLS2A routines. */ ------------------------------------------------------------- */ *ident upsrc1 */ main Use parameter statement to define fieldlength. */ Open the files explicitly in "opench" emulation routine *d wimsd5.2,7 c This is the fixed storage version currently iq is set to mxiq c parameter (mxiq= 1 000 000) dimension iq(mxiq) call wimsd4(iq(1),mxiq) *i wimsd5.9 subroutine opench c Emulate the Winfrith routine - open files explicitly integer dset(30) character*64 name(30) character*20 form(30) character*12 acc(30) character*12 stts(30) c common/dtset/dset,nline common/cdtset/name,form,acc c nline=14 c Input dset(1)= 5 name(1)='WIMSDINP' stts(1)='old' form(1)='formatted' acc (1)=' ' c Output dset(2)= 6 name(2)='WIMSDOUT' stts(2)='unknown' form(2)='formatted' acc (2)=' ' c Binary library dset(3)= 2 name(3)='WIMSDLIB' stts(3)='old' form(3)='unformatted' acc (3)=' ' c dset(4)= 1 name(4)='FOR001' stts(4)='unknown' form(4)='formatted' acc (4)=' ' c dset(5)= 3 name(5)='FOR003' stts(5)='unknown' form(5)='unformatted' acc (5)=' ' c dset(6)= 4 name(6)='FOR004' stts(6)='unknown' form(6)='formatted' acc (6)=' ' c dset(7)= 8 name(7)='FOR008' stts(7)='unknown' form(7)='formatted' acc (7)=' ' c dset(8)= 9 name(8)='FOR009' stts(8)='unknown' form(8)='unformatted' acc (8)=' ' c dset(9)=10 name(9)='FOR010' stts(9)='unknown' form(9)='unformatted' acc (9)=' ' c dset(10)=12 name(10)='FOR012' stts(10)='unknown' form(10)='unformatted' acc (10)=' ' c dset(11)=13 name(11)='FOR013' stts(11)='unknown' form(11)='unformatted' acc (11)=' ' c dset(12)=14 name(12)='FOR014' stts(12)='unknown' form(12)='formatted' acc (12)=' ' c dset(13)=19 name(13)='FOR019' stts(13)='unknown' form(13)='formatted' acc (13)=' ' c dset(14)=20 name(14)='FOR020' stts(14)='unknown' form(14)='formatted' acc (14)=' ' c Open all files do 20 i=1,nline open(unit=dset(i),file=name(i),status=stts(i),form=form(i)) 20 continue c return end subroutine banner(strng,iout,width,qalogo,ierr ) c Emulate the Winfrith routine - print WIMSD-5B head c character*20 strng integer width,qalogo c call tpage(1) c return end */ *ident upsrc2 */ timing - group all machine-dependent routines in this deck */ By default these are dummy routines. */ To re-install machine-dependent timing functions, */ only the timing deck needs to be changed. *i timing.1 subroutine timini(dummy) c c --- ibm version ...initialise timer routine for getting cpu times c tflag=za02as(dummy) c c --- vax version ...initialise timer routine for getting cpu times c iflag=lib$init_timer() c return end *d timing.10 c real tarray(2) *d timing.18,19 c call etime(tarray) c arg = tarray(1) *d timing.36 arg = 0.0 *d timing.73 c call idate(ndate) *d timing.76 c ndate(3)=ndate(3)-1900 *d timing.103,105 ndate(1)=0 ndate(2)=0 ndate(3)=0 *d timing.146,148 c integer time c integer*4 stime c character*24 ctime,chtime *d timing.155 c stime=time() *d timing.158 c chtime=ctime(stime) *d timing.160 c arg = chtime(12:19) *d timing.176 arg = '00:00:00' */ *ident upsrc3 */ prelude - Initialise timing routines through "timini" *d prelud.2321,2326 c initialise timer routine for getting cpu times call timini(dummy) */ *ident upsrc4 */ readda - Split the "if" statement to avoid problems on Alpha/VMS */ When WFOUND is false, WL(1) may contain garbage which */ sometimes causes problems (TEST03). *d readda.464,467 IF (WFOUND) THEN IF(WL(1).NE.'QUAL'.AND.WL(1).NE.'qual') THEN L=-1 WRITE(OPFINO,501) CWORD(1:4) GOTO 160 END IF */ */ ---------------------------------------------------------- */ Updates to extend the number of allowed resonant isotopes */ Proposed by Daniel L. Aldama. */ Adapted for WIMSD-5B by A.Trkov. */ ---------------------------------------------------------- */ *ident up1 */ prelude - Daniel L.Aldama, June 1998 */ Increase the allowed number of resonant isotopes *i prelud.79 c Maximum number of isotopes with resonance tables c Defined in prelud routines: nuprel,prelud c chain1 routine : datag c chain2 routine : two c chain3 routines: ichn03,resalt,resint,three c chain4 routine : four c chain5 routine : ichn05 c chai12 routines: ingres,wimsbx c chai15 routine : datorg,react c chai16 routine : chn16,intsig parameter(nrmax=30) *d prelud.220 4 ,icar,xxfs,idno(nrmax),rnuf(13,nrmax) *d prelud.474 rnutem=ttemp-ng2*nrmax *d prelud.483 & max0(2*nel*(nnfd+nnfpd+2),kbp*nnew,4*nrmax*ng2,6*ng,nmesh*nnew) *d prelud.599 resxsa=ratio-4*nrmax*ng2*ncelld *d prelud.624 resxsq=iaa-4*nrmax*ng2 *i prelud.794 parameter(nrmax=30) *d prelud.1584,1589 resin=pinn-2*nrmax*ng2 resout=resin-2*nrmax*ng2 resid=resout-nrmax indfis=resid-nrmax endee=indfis-nrmax idres=endee-nrmax */ *ident up1a */ chain1 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chain1.273 parameter(nrmax=30) *d chain1.367,368 dimension resid(nrmax),resin(ng2,nrmax,2),resout(ng2,nrmax,2), 1nmix(nofz),vmix(nofz),disad(nofz,ng),indm(nofz1) */ *ident up1b */ chain2 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chain2.317 parameter(nrmax=30) *d chain2.352 common /regcol/ idum(33),idno(nrmax),rnuf(13,nrmax) */ *ident up1c */ chain3 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chain3.117 parameter(nrmax=30) *d chain3.186 common /regcol/idum(32),xxfs,idno(nrmax),rnuf(13,nrmax) *i chain3.375 parameter(nrmax=30) *d chain3.380 common /regcol/ idum(17),icarme,idup(15),idno(nrmax), 1rnuf(13,nrmax) *d chain3.394 2 ncelld),resid(nrmax),indfis(nrmax),idres(nrmax),trans(4,ng) *d chain3.396 4 ,endee(nrmax),resin(ng2,nrmax,2),resout(ng2,nrmax,2) *d chain3.401 dimension rint(nrmax,2,3),resphi(2),respsi(2),x(3),w(4),result(3) *d chain3.570 do 236 inures=1,nrmax *d chain3.804 do 916 inures=1,nrmax *i chain3.856 parameter(nrmax=30) *d chain3.865,866 dimension r(10,30,nrmax,2),te(10,nrmax),s(30,nrmax),ye(10),z(30), 1 resid(nrmax),indfis(nrmax),n2(nrmax),m2(nrmax) *i chain3.1102 parameter(nrmax=30) *d chain3.1132,1133 dimension idres(nrmax), trans(4,ng),fissy(3,ng), 1 sscan(ng),total(2,ng2),endee(nrmax),rootm(ncelld),nann(ncelld), */ *ident up1d */ chain4 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chain4.250 parameter(nrmax=30) *d chain4.280,282 dimension ncode(nnep),resid(nrmax),indfis(nrmax),phi(4,ng), 1 endee(nrmax),resin(ng2,nrmax,2),resout(ng2,nrmax,2) dimension sx(nrmax,2,2),am(nrmax,2,2),f(2) *d chain4.430 6 m=2*nrmax*ng2 */ *ident up1e */ chain5 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chain5.827 parameter(nrmax=30) *d chain5.900 1 icar,xxfs,idno(nrmax),rnuf(13,nrmax) */ *ident up1f */ chai12 - Daniel L.Aldama, June 1998 */ Ref. up1 *d chai12.212 dimension ws(*),wsb(*),rfl(nmesh,nnep),iaa(nel,*),xaa(nel,*) *i chai12.1285 parameter(nrmax=30) *d chai12.1432 j=nrmax *d chai12.1455 if(kj.lt.k.or.j.ne.nrmax) go to 208 *d chai12.1473,1475 207 if(j.eq.nrmax) go to 201 ji=nrmax+1 jj=nrmax+3 *i chai12.2513 parameter(nrmax=30) *d chai12.2563 dimension resid(nrmax),indfis(nrmax),endee(nrmax) *d chai12.2569,2571 dimension ws(*),wsb(*),rfl(nmesh,nnep),iaa(nel,*),xaa(nel,*) 1 ,rtxs(ng,6),rrxs(4,nrmax,ng2) dimension tab(20),idno(nrmax),ttemp(nofz),rnutem(ng2,nrmax) */ *ident up1g */ chai15 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chai15.143 parameter(nrmax=30) *d chai15.151 dimension kv(nmesh),resxsa(nrmax,4,ng2,ncelld) *d chai15.154 dimension resid(nrmax),indfis(nrmax),endee(nrmax) *i chai15.592 parameter(nrmax=30) *d chai15.612,613 dimension acta(ng,n1),actb(ng,n1),actc(ng,n1), 1 resxsa(nrmax,4,ng2,ncelld) */ *ident up1h */ chai16 - Daniel L.Aldama, June 1998 */ Ref. up1 *i chai16.7 parameter(nrmax=30) *d chai16.33,36 dimension kspec(nofz),number(nel),resid(nrmax),dn(nel,nofz),dnew(n 1nuc,nofz),nuco(nnuc),mat(nnuc),kspeq(nnuc),temper(nnuc),kel(nnuc), 1fp(ng2),fofp(ng2,4),phi(ng),wws(ng,4),bdy(ngb),spec(ng0),iaa(nel,* 1),resxsa(nrmax,4,ng2,*),ncode(nnew),md(m6),temp(nofz),ws(nnew), *d chai16.39 dimension dummy(*),aa(nel,*) *i chai16.593 parameter(nrmax=30) *d chai16.598,600 dimension resxsa(nrmax,4,ng2,*),zigtr(ng),ziga(ng),vzigf(ng), 1zigf(ng),v(ng),sigtr(ng3,nt),siga(ng3,nt),vsigf(ng3,nt), sigf(ng3, 2nt),zigs(ng,ng),sigs(ng3,ng3,nt),temps(nt),fp(ng2),pinn(nofz,*), */ *ident up2 */ prelud - Daniel L. Aldama, June 1998 */ Update some array dimensions for consistency *d prelud.477 wsb=ibb-max(100,kbd+1,nnep,nmesh+1,nm+3+nnew+nnew) */ *ident up2a */ chain2 - Daniel L. Aldama, June 1998 */ Ref. up2 *d chain2.326 1 xip1(ng2,5),xip2(nt,ng2,5),bdy(*) *d chain2.329 dimension dataxx(*),store(*),store2(*),store3(*) */ *ident up2b */ chain5 - Daniel L. Aldama, June 1998 */ Ref. up2 *d chain5.50 dimension wl(*) */ *ident up2c */ chain8 - Daniel L. Aldama, June 1998 */ Ref. up2 *d chain8.69 dimension wl(*) */ *ident up2d */ chai12 - Daniel L. Aldama, June 1998 */ Ref. up2 *d chai12.200 dimension rafp(nnfd,*),rbeta(nnep),rc(nnep,nnep),rdbc(nnep) *d chai12.203 dimension rfrac(*) *d chai12.207,208 dimension rsigam(nnep,nofz),rphir(ng,4),ncodeb(ng),nj1(*),nj2(*) 1,indb(mn),indm(nofz1),indi(nnd),iburnz(nofz1),ibb(nel), *d chai12.1330,1331 dimension rafp(nnfd, *),rbeta(nnew),rc(nnew,nnew),rdbc(nnew),rind( 1nnd),rl(* ),rn(nnd,nm),rnu(nnew,nnfd,nm),rnusig(nnew),rphi(nnew,no *d chai12.1335 5odeb(ng),nj1(* ),nj2(* ),indb(nm),indm(nofz1),indi(* ),iburnz(nofz *d chai12.1337,1339 7nmt),ncode(nnew),kspec(nofz),temp(nofz),pout(nofz),ws(200),wsb(* 8),rfl(nmesh,nnew) ,rfrac(* ),igp 9cut(* ),ran(nmt,ncelld) *d chai12.2238,2240 dimension rafp(nnfd,*),rl(* ),rn(nnd,* ),rphi(nnep,nofz1) 1 ,rsiga(nnep,nnd,* ),rsifg(nnep,nnfd,* ),nj1(* ),nj2(* ) 2,indb(* ) *d chai12.2243 dimension rfrac(* ) *d chai12.2566 2 ,indb(mn),indi(nnd),iburnz(nofz1) *d chai12.2998 1s(*),wsb(*),igpcut(*),ran(nmt,ncelld),nann(ncelld),data(25), */ *ident up3 */ wimsdl - Daniel L. Aldama, June 1998 */ Minor patch. Set code version. *d wimsdl.485 data t/'w','i','m','s','d','5','b',' ','r','.','i','.','p','.',' ' */ *ident up4 */ prelud - Daniel L. Aldama, August 1998 */ Restore CHAIN 4 printout when the calculation is performed */ in the library group structure using the option CELL 6. *d prelud.1254 c Deactivate statement to Restore CHAIN 4 printout, CELL 6, all groups c if (lopt.eq.6.and.nnew.eq.ng) lopt=5 */ *ident up5 */ chain2 - Teresa Kulikowska, October 2000 */ Remove error *d chain2.430 102 call werror(2) */--------------------------------------------------------------- */ *ident up6 */ Teresa Kulikowska, October 2000 / Revised May 2001& December 2001 */ Extension to allow more energy groups: */to ensure correct reading of xs in chai16 under option SAVE *d prelud.643 aa=cigs-ng*ng *i prelud.794 c* nng - number of library groups limited to 200 c* nng2 - number of resonance groups limited to 55 parameter(nng=200) parameter(nng2=55) *i prelud.811 996 format('No of resonance groups exceeds',I4,'change parameter') 998 format('No of library groups exceeds',I6,'change parameter') *i prelud.1077 if(ng.gt.nng) go to 999 if(ng2.gt.nng2) go to 997 *i prelud.1289 if(ng.gt.69)then write(iprint,2001) 2001 format('option STORE not allowed with ng>69') stop endif *i prelud.1631 if(ng.gt.nng)go to 999 if(ng2.gt.nng2)go to 997 *i prelud.1648 997 write(iprint,996) stop 999 write(iprint,998) stop */ extension of the field for reading group dependent bucklings *i up1a.5 parameter(nng=200) *d chain1.430 200 iii=3*nng do 220 i=1,iii */ extension of dimensions of local variables through 'parameter' *i chain4.39 parameter (nng=200) *d chain4.64 dimension dummy(nng),stran(3,nng),snfiss(3,nng),ssors(3,nng) */ wl made local to avoid changing of commons for increased number of groups *d chain5.4 * fissy5,scat,xa,xf,xtr,xij,nann,cnum,ng2, *i chain5.8 parameter(ll=500) C wl made local to avoid changing of commons for increased number of groups *d chain5.970 * iq(nann),iq(cnum),ng2,ncelld,ng0,nmt,nnep,nofz, *d up2b.5 dimension wl(ll) */ extension of the number of resonance groups *i chain3.3 parameter (nng2=55) *d chain3.6 dimension sigm(nng2),sgap(nng2),dc(nng2),sig(nng2) *i up1c.9 parameter (nng2=55) *d chain3.406 dimension sigma(nng2),sgap(nng2),dc(nng2) */increased dimension of local variable garbij = 6*ng2 *i chain3.1103 parameter(ll=330) *d chain3.1142 cter increased through 'parameter=330' for extended library in 2000 dimension garbij(ll) */rnuf & idno to be treated as other variables from COMMON/REGCOL/ */with dimensions:idno(nrmax),rnuf(ng2,nrmax) *d up1.17 4 ,icar,xxfs,idno,rnuf *d prelud.228 2,vq,cspec,aint,fissys,xmixm,fiss2s,xfs,xxfs,yfs,rnuf *d prelud.242 rnuf=dnb-ng2*nrmax idno=rnuf-nrmax jp=idno-ncelld *d up1b.7 *d chain2.229 parameter (nrmax=30) common/regcol/irecut,igr,irdump,irfis,irabs,irscat,ixfis,ixabs 1 ,jxsec,irrem,irdz,irdr,irdtr,irgi,ntapxs 2 ,irfiss,ixfiss,icarme,irabsc,iscatc,ixtr,irtr,irtrc, 3 irdtrc,fiss2s,aint,xmixm,xfs,ida,yfs,fissys 4 ,icar,xxfs,idno,rnuf *d chain2.308,309 6IQ(DISAD),IQ(AQ),IQ(FACTND),ICARME,IQ(FISS2S),IQ(AINT),IQ(XMIXM), 7IQ(KSPEC),IQ(IDNO),IQ(RNUF)) *d chain2.317 4 fiss2s,aint,xmixm,kspec,idno,rnuf) *d chain2.322 2 ,xxa(ng2,nofz),xxf(ng2,nofz),idno(nrmax),rnuf(ng2,nrmax) *d up1c.7 common /regcol/idum(32),xxfs,idno,rnuf *d chain3.187 integer xxfs,rnuf *d chain3.255 ciq(xxfs),iq(idno),iq(rnuf),iq(rtub),tout) *d chain3.373 * pinn,recyc,xxfs,idno,rnuf,rad,tout) *d up1c.11,12 common /regcol/ idum(17),icarme,idup(15) *d chain3.399 dimension xxfs(ng2,nofz),idno(nrmax),rnuf(ng2,nrmax) *d chain3.1101 * xxfs,idno,rnuf,rtub,tout) *d chain3.1139 dimension xxfs(ng2,nofz),idno(nrmax),rnuf(ng2,nrmax) *d chain3.1400 * iq(recyc),xxfs,idno,rnuf,rad,tout) */'parameter nrmax is sometimes not necessary now *d up1e.5 *d up1e.7 1 icar,xxfs */--------------------------------------------------------------- */ *ident up7 */ Teresa Kulikowska, May 2001 */ Enable an easy extension of the number of fuel materials in PPEAK *i chai12.1655 parameter(nnm=100) *d chai12.1659,1665 dimension iburnz(nofz1),powerd(nnm),kspec(nofz1),rv(nofz1),rphi(nn 1ew,nofz1),rn(nnd,nm),rsifg(nnew,nnfd,nm),rar(nnn5,nnn1),npinsx(nnm 2),fluxes( *),ran(nmt,*),mesh(nmt,*),fissxc(50 ),flxtlt(5),rod(49, 3nnn1,*),ncoder(nnn6,nnn5,nnn1),iffuel(nnm),ncodea(nmt,*),ryield(*) dimension nsub(nnn1),nzr(nnn5,nnn1) dimension ipeakm(nnm) dimension powerm(nnm) *d chai12.1716,1718 if(nm.le.nnm) go to 51 write(iprint,52)nnm 52 format('0fuel materials in ppeak >',I5,', extend parameter'/) *d chai12.1723 do 12 m=1,nnm */ to enable an easy extension of fuel materials number and */ nuclides in INGRES *i chai12.1285 parameter(nnm=60) parameter(nnnb=300) *d chai12.1340,1341 dimension nann(ncelld),data(25),weight(nnm,nnnb),sigwt(nnnb), 1xrind(nnm),area(nnm),xweigh(nnm),recyc(200) *d chai12.1349,1351 if (nm.lt.nnm.and.nnb.lt.nnnb)go to 33 write(iprint,106)nnm,nnnb 106 format('0only',I3,' materials & ',I5,' nuclides allowed in ingres' 1/) */to correst format in k-infinity printout *d chai14.705 21 format (//8x,i3,1x,('GROUPS.....',2x,'k-infinity',1p,e14.6,3x, */the pseudo tape option 'store' causes errors with extended libraries */if input reading field is not sufficient *d chain1.2056 if(lb.le.index2) go to 60 write(iprint,59) index2,lb 59 format(/' increase library storage allocation at least from',i7,' * to',i7) stop 60 write(jprint,111) la,lb */--------------------------------------------------------------- */ *ident up8 */ Corrections for possibilities of expanded burnup calculations. */ */ Guennadi M. Jerdev */ ABBN Cross Sections Set laboratory */ SSC Of Russian Federation */ Institute of Physics and Power Engineering */ *i chai12.2282 C* ********** C* JGM 21/10/98 C* ABBN Cross Sections Set laboratory C* SSC RF - IPPE C* Set new nuclide densities for virtual isotopes C* and abs.x-sections for isotopes only if x-sections < 0. in all groups nneg=0 nupd=0 DO I=1,NNB IF(IBB(I).GE.100000) THEN C* Found special name (virtual) IBBP=IBB(I)/100000 IBBC=IBB(I)-IBBP*100000 nneg=nneg+1 DO ii=1,NNB C* Search Base isotope IF(IBBC.EQ.IBB(ii)) GOTO 595 END DO WRITE(*,'(1x,''WARNING - Expanded burnup - Base nuclide:'', & i6,'' - not found for smart update '')') IBBC GOTO 596 C* C* Base isotope found 595 nupd=nupd+1 TABS=0. C* Check x-sections DO M=1,NM DO J=1,NNEW TABS=TABS+RSIGA(J,I,M) END DO END DO DO M=1,NM C* Update densities for virtual isotopes RN(I,M)=RN(ii,M) IF(TABS.LE.0.) THEN DO J=1,NNEW C* Update x-sections only if x-sec. .LE.0. RSIGA(J,I,M)=RSIGA(J,ii,M) END DO END IF END DO C* Base isotope not found 596 CONTINUE ELSE ii=0 END IF END DO IF(nneg.GT.0) WRITE(*,'(11x,'' Expanded burnup - Found:'',i4, & '' updated:'',i4,'' isotopes'')') nneg,nupd C* JGM end special code C* ********** *i chai12.2497 C* ********** C* JGM 21/10/98 C* Clear nuclide densities for virtual isotopes nneg=0 DO I=1,NNB IF(IBB(I).GE.100000) THEN C* Found special name nneg=nneg+1 DO M=1,NM C* Reset densities RN(I,M)=1.E-24 END DO END IF END DO IF(nneg.GT.0) WRITE(*,'(11x,'' Expanded burnup - '', & ''Cleared for:'',i4,'' isotopes'')') nneg C* JGM end special code C* ********** */ *ident up9 */ Corrections RESINT module */ These corrections offer the opportunity to incluide isotopes with */ res.tables in the JOB input for burnup calculations (such as 3239.1) */ */ Guennadi M. Jerdev */ ABBN Cross Sections Set laboratory */ SSC Of Russian Federation */ Institute of Physics and Power Engineering */ *d chain3.911 3 IRESID=RESID(IRES) key=0 ASS=AS IASS=AS IF(IRESID.EQ.RESID(IRES)) ASS=IASS IF(ABS(ASS-RESID(IRES))-0.05) 22,1,1 */--------------------------------------------------------------- *ident up10 */ Modifications following J. Fink from Argentine *d chain1.485 c tol=1.e-4 (putting default value of tol = 1.e-5 J.F. 10/2000) tol=1.e-5 */ (updating Avogadro number and e charge J.F. 10/2000) *d chai12.2165 c ener=rpower/(rfissr*0.6025*1.6e-13) ener=rpower/(rfissr*0.6022142*1.6021765d-13) *d chai12.3413,3414 c caleb(38)=caleb(12)*recyc(130)/0.602306 c caleb(39)=caleb(13)*recyc(143)/0.602306 caleb(38)=caleb(12)*recyc(130)/0.6022142 caleb(39)=caleb(13)*recyc(143)/0.6022142 */ addition to avoid precision problems for very thin annuli */ (J.F. 10/2000) *i chain4.469 real*8 y,a,g *d chain4.487 y=(0.75*y-0.25-0.5*dlog(y)*y*y/(y-1.0))/(y-1.0) */--------------------------------------------------------------- */ *ident up11 */ T. Kulikowska, 15 March 2002 */ Increase the number of inner itarations in DSN *d chain6.768 95 if (j5-100) 122,124,124 */--------------------------------------------------------------- *ident up12 */ T. Kulikowska, 23 January 2003 */ print effective micro x-sections together with reaction rates */ print flux in materials and groups given on PARTITION card *i prelud.99 common/micsec/flupo,flumat,xmicr integer flupo,flumat,xmicr *d prelud.607 flupo=nfrate-ipvt*nmesh flumat=flupo-ipvt*nofz xmicr=flumat-ipvt*nofz abreac=xmicr-ipvt*nofz *i prelud.864 common/micsec/flupo,flumat,xmicr *i chai15.21 common/micsec/flupo,flumat,xmicr *d chai15.41 * nofz1,hyphi,nzhy,jans,flupo,flumat,xmicr *d chai15.102 * iq(atwt),iq(recyc),iq(pinn),iq(pout), * iq(flupo),iq(flumat),iq(xmicr)) *d chai15.117 * iq(atwt),iq(recyc),iq(pinn),iq(pout), * iq(flupo),iq(flumat),iq(xmicr)) *d chai15.591 * temp,atwt,recyc,pinn,pout, * flupo,flumat,xmicr) *i chai15.622 dimension flupo(ipvtmp,nmesh) dimension flumat(ipvtmp,nofz) dimension xmicr(ipvtmp,nofz) *i chai15.728 flupo(i,m)=0.0 *i chai15.758 flupo(i,m)=flupo(i,m)+ff(kk) *i chai15.774 flupo(i,m)=flupo(i,m)+ff(kk) *i chai15.853 690 format('effective microscopic X-sections') *i chai15.862 flumat(i,nz)=0.0 *i chai15.872 flumat(i,nz)=flumat(i,nz)+v(m)*flupo(i,m)/vlr(nz,icell) *i chai15.887 do 691 nz=1,nofz do 691 i=1,ipvt 691 xmicr(i,nz)=abreac(i,nz)/flumat(i,nz) write(iprint,690) call fluprint(xmicr,nofz,ipvtmp,ipvtmp,nofz) *i chai15.895 do 692 nz=1,nofz do 692 i=1,ipvt 692 xmicr(i,nz)=fireac(i,nz)/flumat(i,nz) write(iprint,690) call fluprint(xmicr,nofz,ipvtmp,ipvtmp,nofz) *i chai15.902 do 693 nz=1,nofz do 693 i=1,ipvt 693 xmicr(i,nz)=yfreac(i,nz)/flumat(i,nz) write(iprint,690) call fluprint(xmicr,nofz,ipvtmp,ipvtmp,nofz) *i chai15.1151 write(iprint,694) 694 format('flux in reaction rates structure') call fluprint(flumat,nofz,ipvtmp,ipvtmp,nmesh) *i chai15.1174 subroutine fluprint(flux,ma,ipvtmp,dumm,nmesh) common pc(310) common /mdp/ iprint,iin,iout,ipunch,loc,disc9 common/iist/ihist,ihis dimension flux(ipvtmp,*) character*6 word equivalence (pc(301),ipvt),(pc(306),m6) data word/'materl'/ if(m6-ma) 5,7,7 7 ll=1 mm=8 6 nn=min(ma,mm) write(iprint,102)word,(m,m=ll,nn) do 3 i=1,ipvt write(iprint,100)i,(flux(i,m),m=ll,nn) 3 continue if(nn-ma) 4,5,5 4 ll=nn+1 mm=mm+8 go to 6 5 return 100 format(i6,6x,1p,8e13.5) 102 format(' group ',a6,i8,7i13) end */--------------------------------------------------------------- */ *ident vers */ prelud - Version control printout */ The following is a record from a format statement. */ When editing, make sure that the number of columns after */ the continuation character "+" remains the same: */ +'* text text text ... *',/25x, *d prelud.2117 +'* Version 2003/01 (DOS/Lahey) *',/25x,