From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Dragon/src/USSIST.f | 509 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 509 insertions(+) create mode 100644 Dragon/src/USSIST.f (limited to 'Dragon/src/USSIST.f') diff --git a/Dragon/src/USSIST.f b/Dragon/src/USSIST.f new file mode 100644 index 0000000..be654e0 --- /dev/null +++ b/Dragon/src/USSIST.f @@ -0,0 +1,509 @@ +*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 -- cgit v1.2.3