*DECK USSIST SUBROUTINE USSIST(MAXNOR,NGRP,MASKG,IRES,IPLI0,IPTRK,IFTRAK, 1 CDOOR,IMPX,NBMIX,NREG,NUN,NL,IPHASE,MAXST,MAT,VOL,KEYFLX,LEAKSW, 2 IREX,SIGGAR,TITR,ICORR,NIRES,NBNRS,NOR,CONR,GOLD,IPPT1,IPPT2, 3 STGAR,SSGAR,VOLMER,UNGAR) * *----------------------------------------------------------------------- * *Purpose: * Compute the multiband fluxes as required by the subgroup method using * the subgroup projection method (SPM): * a) assume a single resonant isotope; * b) use the standard solution doors of Dragon. * *Copyright: * Copyright (C) 2007 Ecole Polytechnique de Montreal * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version * *Author(s): A. Hebert * *Parameters: input * MAXNOR maximum order of the probability tables (PT). * NGRP number of energy group. * MASKG energy group mask pointing on self-shielded groups. * IRES index of the resonant isotope. * IPLI0 pointer to the internal microscopic cross section library * builded by the self-shielding module. * IPTRK pointer to the tracking (L_TRACK signature). * IFTRAK file unit number used to store the tracks. * CDOOR name of the geometry/solution operator. * IMPX print flag (equal to zero for no print). * NBMIX number of mixtures in the internal library. * NREG number of regions. * NUN number of unknowns in the flux or source vector in one * energy group and one band. * NL number of Legendre orders required in the calculation * (NL=1 or higher). * IPHASE type of flux solution (=1 use a native flux solution door; * =2 use collision probabilities). * MAXST maximum number of fixed point iterations for the ST scattering * source. * MAT index-number of the mixture type assigned to each volume. * VOL volumes. * KEYFLX pointers of fluxes in unknown vector. * LEAKSW leakage switch (LEAKSW=.TRUE. if neutron leakage through * external boundary is present). * IREX fuel region index assigned to each mixture. Equal to zero * in non-resonant mixtures or in mixtures not used. * SIGGAR macroscopic x-s of the non-resonant isotopes in each mixture: * (*,*,*,1) total; (*,*,*,2) transport correction; * (*,*,*,3) P0 scattering; (*,*,*,4) flux times P0 scattering. * TITR title. * ICORR mutual resonance shielding flag (=1 to suppress the model * in cases it is required in LIB operator). * NIRES exact number of correlated resonant isotopes. * NBNRS number of correlated fuel regions. * NOR exact order of the probability table. * CONR number density of the resonant isotopes. * GOLD type of self-shielding model (=1.0 physical probability * tables; =-998.0/-1000.0 subgroup projection method). * IPPT1 pointer to LCM directory of each resonant isotope. * IPPT2 information related to each resonant isotope: * IPPT2(:,1) index of a resonant region (used with infinite * dilution case); * IPPT2(:,2:4) alias name of resonant isotope. * STGAR averaged microscopic total xs in resonant region. * SSGAR averaged microscopic scattering xs in resonant region. * VOLMER volumes of the resonant regions. * *Parameters: output * UNGAR averaged flux unknowns. * *----------------------------------------------------------------------- * USE GANLIB USE DOORS_MOD *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPLI0,IPTRK,IPPT1(NIRES) INTEGER MAXNOR,NGRP,IRES,IFTRAK,IMPX,NBMIX,NREG,NUN,NL,IPHASE, 1 MAXST,MAT(NREG),KEYFLX(NREG),IREX(NBMIX),ICORR,NIRES,NBNRS, 2 NOR(NIRES,NGRP),IPPT2(NIRES,4) REAL VOL(NREG),SIGGAR(NBMIX,0:NIRES,NGRP,4), 1 CONR(NBNRS,NIRES),GOLD(NIRES,NGRP),STGAR(NBNRS,NIRES,NGRP), 2 SSGAR(NBNRS,NIRES,NL,NGRP),VOLMER(0:NBNRS), 3 UNGAR(NUN,NIRES,NGRP) CHARACTER CDOOR*12,TITR*72 LOGICAL LEAKSW,MASKG(NGRP) *---- * LOCAL VARIABLES *---- TYPE(C_PTR) IPSYS,JPLIB,KPLIB,KPSYS,JPLI0,JPLI01,IPMACR,IPSOU CHARACTER CBDPNM*12,TEXT12*12,TEXX12*12,HSMG*131 DOUBLE PRECISION ZNUM,ZDEN LOGICAL EMPTY,LCM,LEXAC,LSPM,REBFLG INTEGER NALBP *---- * ALLOCATABLE STATEMENTS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: NPSYS REAL, ALLOCATABLE, DIMENSION(:) :: SIGTXS,SIGS0X,SIGG,FLNEW,WCOR, 1 FUN,SUN REAL, ALLOCATABLE, DIMENSION(:,:) :: WEIGH,TOTPT,SIGWS REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XFLUX TYPE(C_PTR) SIGP_PTR REAL, POINTER, DIMENSION(:) :: SIGP *---- * FIND THE NUMBER OF COMPONENTS REQUIRED AND ALLOCATE THE LIST OF * ASSEMBLY MATRICES. *---- NASM=0 DO 10 IGRP=1,NGRP LSPM=(MASKG(IGRP).AND.((GOLD(IRES,IGRP).EQ.-998.).OR. 1 (GOLD(IRES,IGRP).EQ.-1000.))) IF(LSPM) NASM=NASM+NOR(IRES,IGRP) 10 CONTINUE IF(NASM.EQ.0) RETURN IF(NGRP.LT.250) CALL XABORT('USSIST: THIS SIMPLIFIED SELF-SHIELD' 1 //'ING MODEL REQUIRES MORE THAN 250 ENERGY GROUPS.') *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(NPSYS(MAXNOR*NGRP)) ALLOCATE(XFLUX(NBNRS,MAXNOR,NIRES),SIGTXS(0:NBMIX), 1 SIGS0X(0:NBMIX),SIGG(0:NBMIX),WEIGH(MAXNOR,NIRES), 2 TOTPT(MAXNOR,NIRES),SIGWS(MAXNOR,NIRES),FLNEW(NBNRS), 3 WCOR(MAXNOR**2)) *---- * CREATE A SPECIFIC DIRECTORY FOR IRES-TH RESONANT ISOTOPE. *---- WRITE(CBDPNM,'(3HCOR,I4.4,1H/,I4.4)') IRES,NIRES CALL LCMSIX(IPLI0,CBDPNM,1) JPLI0=LCMGID(IPLI0,'NWT0-PT') IPSYS=LCMLID(IPLI0,'ASSEMB-RIBON',NASM) CALL LCMSIX(IPLI0,' ',2) *---- * LOOP OVER THE ENERGY GROUPS. *---- IASM=0 DO 100 IGRP=1,NGRP LSPM=(MASKG(IGRP).AND.((GOLD(IRES,IGRP).EQ.-998.).OR. 1 (GOLD(IRES,IGRP).EQ.-1000.))) IF(LSPM) THEN IF(IMPX.GT.2) THEN WRITE(TEXT12,'(3A4)') (IPPT2(IRES,J0),J0=2,4) WRITE(6,'(36H USSIST: PROCESS CORRELATED ISOTOPE ,A12, 1 11H WITH INDEX,I3,9H IN GROUP,I4,22H (SUBGROUP PROJECTION , 2 8HMETHOD).)') TEXT12,IRES,IGRP ENDIF DO 20 JRES=1,NIRES IF(GOLD(JRES,IGRP).NE.GOLD(IRES,IGRP)) THEN WRITE(HSMG,'(32HUSSIST: PT NOT SET FOR ISOTOPE '',3A4, 1 10H'' IN GROUP,I5,1H.)') (IPPT2(JRES,J0),J0=2,4),IGRP CALL XABORT(HSMG) ELSE IF(NOR(JRES,IGRP).GT.MAXNOR) THEN CALL XABORT('USSIST: MAXNOR OVERFLOW.') ENDIF 20 CONTINUE NORI=NOR(IRES,IGRP) DO 40 JRES=1,NIRES *---- * RECOVER THE PREVIOUS FLUXES. *---- IF(NOR(JRES,IGRP).EQ.1) THEN XFLUX(:NBNRS,:MAXNOR,JRES)=1.0 ELSE WRITE(CBDPNM,'(3HCOR,I4.4,1H/,I4.4)') JRES,NIRES CALL LCMSIX(IPLI0,CBDPNM,1) JPLI01=LCMGID(IPLI0,'NWT0-PT') CALL LCMLEL(JPLI01,IGRP,ILON,ITYLCM) IF(ILON.GT.NBNRS*MAXNOR) THEN WRITE(TEXT12,'(3A4)') (IPPT2(IRES,J0),J0=2,4) WRITE(HSMG,'(34HUSSIST: FLUX OVERFLOW FOR ISOTOPE ,A12)') 1 TEXT12 CALL XABORT(HSMG) ENDIF CALL LCMGDL(JPLI01,IGRP,XFLUX(1,1,JRES)) CALL LCMSIX(IPLI0,' ',2) ENDIF *---- * COLLECT THE BASE POINTS IN TOTAL CROSS SECTION. *---- JPLIB=LCMGID(IPPT1(JRES),'GROUP-PT') CALL LCMLEL(JPLIB,IGRP,ILONG,ITYLCM) IF(ILONG.NE.0) THEN KPLIB=LCMGIL(JPLIB,IGRP) CALL LCMINF(KPLIB,TEXT12,TEXX12,EMPTY,ILONG,LCM) CALL LCMLEN(KPLIB,'PROB-TABLE',LENG,ITYLCM) NPART=LENG/MAXNOR IF(LCM) THEN CALL LCMGPD(KPLIB,'PROB-TABLE',SIGP_PTR) CALL C_F_POINTER(SIGP_PTR,SIGP,(/ MAXNOR*NPART /)) ELSE ALLOCATE(SIGP(MAXNOR*NPART)) CALL LCMGET(KPLIB,'PROB-TABLE',SIGP) ENDIF DO 30 INOR=1,NOR(JRES,IGRP) WEIGH(INOR,JRES)=SIGP(INOR) TOTPT(INOR,JRES)=SIGP(MAXNOR+INOR) SIGWS(INOR,JRES)=SIGP(3*MAXNOR+INOR) 30 CONTINUE IF(.NOT.LCM) DEALLOCATE(SIGP) ELSE WEIGH(1,JRES)=1.0 TOTPT(1,JRES)=STGAR(IPPT2(JRES,1),JRES,IGRP) SIGWS(1,JRES)=SSGAR(IPPT2(JRES,1),JRES,1,IGRP) ENDIF 40 CONTINUE *---- * SET THE MIXTURE-DEPENDENT CROSS SECTIONS. *---- JPLIB=LCMGID(IPPT1(IRES),'GROUP-PT') KPLIB=LCMGIL(JPLIB,IGRP) DO 90 INOR=1,NORI SIGTXS(0:NBMIX)=0.0 SIGS0X(0:NBMIX)=0.0 DO 80 IBM=1,NBMIX IND=IREX(IBM) DO 70 JRES=0,NIRES IF(JRES.EQ.0) THEN * ADMIXED NON-RESONANT ISOTOPES. SIGTXS(IBM)=SIGTXS(IBM)+(SIGGAR(IBM,0,IGRP,1)- 1 SIGGAR(IBM,0,IGRP,2)) SIGS0X(IBM)=SIGS0X(IBM)-SIGGAR(IBM,0,IGRP,2) ELSE IF((JRES.NE.IRES).AND.(IND.GT.0)) THEN * MUTUAL SHIELDING MODEL FROM CORRELATED RESONANT ISOTOPES. WRITE(TEXT12,'(3A4)') (IPPT2(JRES,I0),I0=2,4) IF((NOR(JRES,IGRP).GT.1).AND.(ICORR.NE.1)) THEN CALL LCMLEN(KPLIB,TEXT12,ILEN,ITYLCM) IF(ILEN.EQ.0) THEN CALL LCMLIB(KPLIB) CALL XABORT('USSIST: UNABLE TO FIND CORRELATED ISOTO' 1 //'PE '//TEXT12//'.') ENDIF CALL LCMGET(KPLIB,TEXT12,WCOR) ENDIF IF((ICORR.EQ.1).AND. * ECCO CORRELATION MODEL. 1 (IPPT2(IRES,2).EQ.IPPT2(JRES,2)).AND. 1 (IPPT2(IRES,3).EQ.IPPT2(JRES,3))) THEN SIGTXS(IBM)=SIGTXS(IBM)+CONR(IND,JRES)*TOTPT(INOR,IRES) ELSE ZNUM=0.0D0 ZDEN=0.0D0 DO 60 I2=1,NOR(JRES,IGRP) IF((ICORR.EQ.1).OR.(NOR(JRES,IGRP).EQ.1)) THEN WWW=WEIGH(INOR,IRES)*WEIGH(I2,JRES)*XFLUX(IND,I2,JRES) ELSE WWW=WCOR((I2-1)*NORI+INOR)*XFLUX(IND,I2,JRES) ENDIF ZNUM=ZNUM+WWW*CONR(IND,JRES)*TOTPT(I2,JRES) ZDEN=ZDEN+WWW 60 CONTINUE IF(ZNUM/ZDEN.LT.0.0) THEN * BADLY BEHAVED CORRELATED WEIGHT MATRIX. ZNUM=0.0D0 ZDEN=0.0D0 DO 65 I2=1,NOR(JRES,IGRP) WWW=WEIGH(INOR,IRES)*WEIGH(I2,JRES)*XFLUX(IND,I2,JRES) ZNUM=ZNUM+WWW*CONR(IND,JRES)*TOTPT(I2,JRES) ZDEN=ZDEN+WWW 65 CONTINUE ENDIF SIGTXS(IBM)=SIGTXS(IBM)+REAL(ZNUM/ZDEN) ENDIF ENDIF 70 CONTINUE IF(IND.GT.0) THEN SIGTXS(IBM)=SIGTXS(IBM)+CONR(IND,IRES)*TOTPT(INOR,IRES) SIGS0X(IBM)=SIGS0X(IBM)+WEIGH(INOR,IRES)*CONR(IND,IRES)* 1 SIGWS(INOR,IRES) ENDIF 80 CONTINUE IASM=IASM+1 NPSYS(IASM)=IASM KPSYS=LCMDIL(IPSYS,IASM) CALL LCMPUT(KPSYS,'DRAGON-TXSC',NBMIX+1,2,SIGTXS(0)) CALL LCMPUT(KPSYS,'DRAGON-S0XSC',NBMIX+1,2,SIGS0X(0)) 90 CONTINUE ELSE IF(GOLD(IRES,IGRP).EQ.-998.) THEN CALL LCMLEL(JPLI0,IGRP,LENG0,ITYLCM) IF(LENG0.NE.0) THEN WRITE(HSMG,'(42HUSSIST: UNEXPECTED SELF-SHIELDING DATA FOU, 1 11HND IN GROUP,I5,1H.)') IGRP CALL XABORT(HSMG) ENDIF ELSE IF(GOLD(IRES,IGRP).EQ.-1000.) THEN CALL LCMLEL(JPLI0,IGRP,LENG0,ITYLCM) IF(LENG0.NE.0) THEN WRITE(HSMG,'(42HUSSIST: UNEXPECTED SELF-SHIELDING DATA FOU, 1 11HND IN GROUP,I5,1H.)') IGRP CALL XABORT(HSMG) ENDIF ENDIF 100 CONTINUE *---- * ASSEMBLY MATRIX OR REDUCED COLLISION PROBABILITIES CALCULATION. *---- NANI=1 KNORM=1 NALBP=0 IMPY=MAX(0,IMPX-3) IF(IPHASE.EQ.1) THEN * USE A NATIVE DOOR. ISTRM=1 NW=0 CALL DOORAV(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPY,NASM,NREG, 1 NBMIX,NANI,NW,MAT,VOL,KNORM,LEAKSW,TITR,NALBP,ISTRM) ELSE IF(IPHASE.EQ.2) THEN * USE A COLLISION PROBABILITY DOOR. IPIJK=1 ITPIJ=1 CALL DOORPV(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPY,NASM,NREG, 1 NBMIX,NANI,MAT,VOL,KNORM,IPIJK,LEAKSW,ITPIJ,.FALSE.,TITR, 2 NALBP) ENDIF *---- * LOOP OVER THE ENERGY GROUPS. *---- IASM=0 DO 280 IGRP=1,NGRP LSPM=(MASKG(IGRP).AND.((GOLD(IRES,IGRP).EQ.-998.).OR. 1 (GOLD(IRES,IGRP).EQ.-1000.))) IF(LSPM) THEN NORI=NOR(IRES,IGRP) *---- * COLLECT THE BASE POINTS IN PARTIAL CROSS SECTION. *---- DO 120 JRES=1,NIRES JPLIB=LCMGID(IPPT1(JRES),'GROUP-PT') CALL LCMLEL(JPLIB,IGRP,ILONG,ITYLCM) IF(ILONG.NE.0) THEN KPLIB=LCMGIL(JPLIB,IGRP) CALL LCMINF(KPLIB,TEXT12,TEXX12,EMPTY,ILONG,LCM) CALL LCMLEN(KPLIB,'PROB-TABLE',LENG,ITYLCM) NPART=LENG/MAXNOR IF(LCM) THEN CALL LCMGPD(KPLIB,'PROB-TABLE',SIGP_PTR) CALL C_F_POINTER(SIGP_PTR,SIGP,(/ MAXNOR*NPART /)) ELSE ALLOCATE(SIGP(MAXNOR*NPART)) CALL LCMGET(KPLIB,'PROB-TABLE',SIGP) ENDIF DO 110 INOR=1,NOR(JRES,IGRP) WEIGH(INOR,JRES)=SIGP(INOR) SIGWS(INOR,JRES)=SIGP(3*MAXNOR+INOR) 110 CONTINUE IF(.NOT.LCM) DEALLOCATE(SIGP) ELSE WEIGH(1,JRES)=1.0 SIGWS(1,JRES)=SSGAR(IPPT2(JRES,1),JRES,1,IGRP) ENDIF 120 CONTINUE *---- * RECOVER THE PREVIOUS FLUXES. *---- WRITE(CBDPNM,'(3HCOR,I4.4,1H/,I4.4)') IRES,NIRES CALL LCMSIX(IPLI0,CBDPNM,1) JPLI01=LCMGID(IPLI0,'NWT0-PT') CALL LCMLEL(JPLI01,IGRP,ILON,ITYLCM) IF(ILON.GT.NBNRS*MAXNOR) THEN WRITE(TEXT12,'(3A4)') (IPPT2(IRES,J0),J0=2,4) WRITE(HSMG,'(34HUSSIST: FLUX OVERFLOW FOR ISOTOPE ,A12)') 1 TEXT12 CALL XABORT(HSMG) ENDIF CALL LCMGDL(JPLI01,IGRP,XFLUX(1,1,IRES)) CALL LCMSIX(IPLI0,' ',2) *---- * ITERATIVE PROCEDURE. *---- ITER=0 140 ITER=ITER+1 IF(ITER.GT.MAXST) GO TO 240 ERR1=0.0 ERR2=0.0 *---- * COMPUTE THE AVERAGED SOURCE. *---- ALLOCATE(FUN(NUN*NORI),SUN(NUN*NORI)) SUN(:NUN*NORI)=0.0 DO 195 INOR=1,NORI KPSYS=LCMGIL(IPSYS,IASM+INOR) CALL LCMLEN(KPSYS,'FUNKNO$USS',ILENG,ITYLCM) IF(ILENG.EQ.NUN) THEN CALL LCMGET(KPSYS,'FUNKNO$USS',FUN((INOR-1)*NUN+1)) ELSE FUN((INOR-1)*NUN+1:INOR*NUN)=0.0 ENDIF NPSYS(INOR)=IASM+INOR SIGG(0)=0.0 DO 190 IBM=1,NBMIX SIGG(IBM)=SIGGAR(IBM,0,IGRP,3) IND=IREX(IBM) DO 150 JRES=1,NIRES IF((JRES.NE.IRES).AND.(IND.GT.0)) THEN SIGG(IBM)=SIGG(IBM)+SIGGAR(IBM,JRES,IGRP,4) ENDIF 150 CONTINUE IF(IND.GT.0) THEN DO 160 JNOR=1,NORI IF(JNOR.NE.INOR) THEN SIGG(IBM)=SIGG(IBM)+WEIGH(JNOR,IRES)*CONR(IND,IRES)* 1 SIGWS(JNOR,IRES)*XFLUX(IND,JNOR,IRES) ENDIF 160 CONTINUE ENDIF 190 CONTINUE IOF=(INOR-1)*NUN CALL DOORS(CDOOR,IPTRK,NBMIX,0,NUN,SIGG,SUN(IOF+1)) 195 CONTINUE *---- * SOLVE FOR THE MULTIBAND FLUX. *---- IDIR=0 LEXAC=.FALSE. IPMACR=C_NULL_PTR IPSOU=C_NULL_PTR REBFLG=.FALSE. CALL DOORFV(CDOOR,IPSYS,NPSYS,IPTRK,IFTRAK,IMPX,NORI,NBMIX, 1 IDIR,NREG,NUN,IPHASE,LEXAC,MAT,VOL,KEYFLX,TITR,SUN,FUN,IPMACR, 2 IPSOU,REBFLG) *---- * HOMOGENIZE THE FLUX AT ITERATION ITER. *---- UNGAR(:NUN,IRES,IGRP)=0.0 DO 235 INOR=1,NORI KPSYS=LCMGIL(IPSYS,IASM+INOR) CALL LCMPUT(KPSYS,'FUNKNO$USS',NUN,2,FUN((INOR-1)*NUN+1)) FLNEW(:NBNRS)=0.0 DO 200 I=1,NREG IF(MAT(I).EQ.0) GO TO 200 IOF=(INOR-1)*NUN+KEYFLX(I) IND=IREX(MAT(I)) IF(IND.GT.0) FLNEW(IND)=FLNEW(IND)+FUN(IOF)*VOL(I) 200 CONTINUE DO 210 IND=1,NBNRS FLNEW(IND)=FLNEW(IND)/VOLMER(IND) 210 CONTINUE * DO 220 I=1,NUN IOF=(INOR-1)*NUN+I UNGAR(I,IRES,IGRP)=UNGAR(I,IRES,IGRP)+FUN(IOF)*WEIGH(INOR,IRES) 220 CONTINUE *---- * CONVERGENCE CONTROL. *---- DO 230 IND=1,NBNRS ERR1=MAX(ERR1,ABS(FLNEW(IND)-XFLUX(IND,INOR,IRES))) ERR2=MAX(ERR2,ABS(FLNEW(IND))) XFLUX(IND,INOR,IRES)=FLNEW(IND) 230 CONTINUE 235 CONTINUE DEALLOCATE(SUN,FUN) IF(IMPX.GT.2) THEN WRITE(TEXT12,'(3A4)') (IPPT2(IRES,I),I=2,4) WRITE(6,'(15H USSIST: GROUP=,I5,20H. SUBGROUP ITERATION,I4, 1 11H. ISOTOPE='',A12,9H''. ERROR=,1P,E11.4,1H.)') 2 IGRP,ITER,TEXT12,ERR1 ENDIF IF(ERR2.GT.1.0E10) GO TO 240 IF(ERR1.GT.1.0E-4*ERR2) GO TO 140 IF(IMPX.GT.1) THEN WRITE(TEXT12,'(3A4)') (IPPT2(IRES,I),I=2,4) WRITE(6,'(15H USSIST: GROUP=,I5,24H. SUBGROUP ITERATION CON, 1 11HVERGENCE IN,I4,22H ITERATIONS. ISOTOPE='',A12,2H''.)') 2 IGRP,ITER,TEXT12 ENDIF GO TO 250 *---- * ALTERNATIVE TREATMENT IN CASE OF FAILURE OF FIXED POINT ITERATIONS. * USE A NON-ITERATIVE RESPONSE MATRIX APPROACH. *---- 240 IF(IMPX.GT.0) THEN WRITE(TEXT12,'(3A4)') (IPPT2(IRES,I),I=2,4) WRITE(6,'(15H USSIST: GROUP=,I5,24H. SUBGROUP ITERATION FAI, 1 16HLED FOR ISOTOPE ,A12,32H. USE AN ALTERNATIVE RESPONSE MA, 2 14HTRIX APPROACH.)') IGRP,TEXT12 ENDIF CALL USSEXC(MAXNOR,CDOOR,IPLI0,IPTRK,IFTRAK,IMPX,NGRP,IGRP, 1 IASM,NBMIX,NREG,NUN,NL,IPHASE,MAT,VOL,KEYFLX,IREX,SIGGAR,TITR, 2 NIRES,IRES,NBNRS,NOR,CONR,IPPT1,IPPT2,STGAR,SSGAR,VOLMER, 3 XFLUX(1,1,IRES),UNGAR) 250 IF(IMPX.GT.2) THEN DO 270 IND=1,NBNRS T1=0.0 DO 260 INOR=1,NORI T1=T1+WEIGH(INOR,IRES)*XFLUX(IND,INOR,IRES) 260 CONTINUE WRITE(6,'(31H USSIST: AVERAGED FLUX IN GROUP,I4,9H AND RESO, 1 11HNANT REGION,I4,21H FOR RESONANT ISOTOPE,I4,2H =,F9.5)') 2 IGRP,IND,IRES,T1 270 CONTINUE ENDIF CALL LCMPDL(JPLI0,IGRP,NBNRS*NORI,2,XFLUX(1,1,IRES)) IASM=IASM+NORI ENDIF 280 CONTINUE *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(WCOR,FLNEW,SIGWS,TOTPT,WEIGH,SIGG,SIGS0X,SIGTXS,XFLUX) DEALLOCATE(NPSYS) RETURN END