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/AUTONE.f | 509 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 509 insertions(+) create mode 100644 Dragon/src/AUTONE.f (limited to 'Dragon/src/AUTONE.f') diff --git a/Dragon/src/AUTONE.f b/Dragon/src/AUTONE.f new file mode 100644 index 0000000..3a95006 --- /dev/null +++ b/Dragon/src/AUTONE.f @@ -0,0 +1,509 @@ +*DECK AUTONE + SUBROUTINE AUTONE(IPLI0,IPTRK,IPLIB,IFTRAK,CDOOR,IMPX,INRS, + 1 IGRMIN,IGRRES,IGRMAX,NGRP,NBMIX,NREG,NUN,NBISO,NL,NED,NDEL, + 2 ISONAM,IHSUF,DEN,LSHI,DIL,MIX,MAT,VOL,KEYFLX,LEAKSW,ITRANC, + 3 IPHASE,TITR,KSPH,IALTER,DELI,LBIN,NBIN,EBIN,MAXTRA,ISEED) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Perform a resonance self-shielding calculation in resonant region +* INRS and build a corresponding internal library for the Autosecol +* method. +* +*Copyright: +* Copyright (C) 2023 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 +* IPLI0 pointer to the internal microscopic cross section library +* builded by the self-shielding module (L_LIBRARY signature). +* IPTRK pointer to the tracking. (L_TRACK signature). +* IPLIB pointer to the internal microscopic cross section library +* with subgroups (L_LIBRARY signature). +* IFTRAK unit number of the sequential binary tracking file. +* CDOOR name of the geometry/solution operator. +* IMPX print flag (equal to zero for no print). +* INRS resonant region index. +* IGRMIN first group where the self-shielding is applied. +* IGRRES first resolved energy group. +* IGRMAX most thermal group where the self-shielding is applied. +* NGRP number of energy groups. +* NBMIX number of mixtures in the internal library. +* NREG number of regions. +* NUN number of unknowns per energy group. +* NBISO number of isotopes specifications in the internal library. +* NL number of Legendre orders required in the calculation +* (NL=1 or higher). +* NED number of extra vector edits. +* NDEL number of delayed neutron precursor groups. +* ISONAM alias name of isotopes. +* IHSUF suffix name of isotopes. +* DEN density of each isotope. +* LSHI resonant region index assigned to each isotope. +* DIL microscopic dilution cross section of each isotope. +* MIX mix number of each isotope (can be zero). +* MAT index-number of the mixture type assigned to each volume. +* VOL volumes. +* KEYFLX pointers of fluxes in unknown vector. +* LEAKSW leakage flag (LEAKSW=.TRUE. if neutron leakage through +* external boundary is present). +* ITRANC type of transport correction. +* IPHASE type of flux solution (=1 use a native flux solution door; +* =2 use collision probabilities). +* TITR title. +* KSPH SPH equivalence flag (=0 no SPH correction; =1 SPH correction +* in the fuel). +* IALTER type of elastic slowing-down kernel (=0: use exact kernel; +* =1: use an approximate kernel for the resonant isotopes). +* DELI elementary lethargy width used by the elastic kernel. +* LBIN total number of fine energy groups in the Autolib. +* NBIN number of fine energy groups in each coarse energy group. +* EBIN energy limits of the Autolib fine groups. +* MAXTRA maximum number of down-scattering terms. +* ISEED the seed for the generation of random numbers in the +* unresolved energy domain. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLI0,IPTRK,IPLIB + INTEGER IFTRAK,IMPX,INRS,IGRMIN,IGRRES,IGRMAX,NGRP,NBMIX,NREG, + 1 NUN,NBISO,NL,NED,NDEL,ISONAM(3,NBISO),IHSUF(NBISO),LSHI(NBISO), + 2 MIX(NBISO),MAT(NREG),KEYFLX(NREG),ITRANC,IPHASE,KSPH,IALTER, + 3 LBIN,NBIN(NGRP),MAXTRA,ISEED + REAL DEN(NBISO),DIL(NBISO),VOL(NREG),DELI,EBIN(LBIN+1) + LOGICAL LEAKSW + CHARACTER CDOOR*12,TITR*72 +*---- +* LOCAL VARIABLES +*---- + DOUBLE PRECISION VOLTOT,GAR0,GAR1,GAR2,GAR3,GAR4 + CHARACTER TEXT4*4,HCAL*12,NAME*12,TEXT12*12,HSMG*131 + LOGICAL LABS + TYPE(C_PTR) KPLIB +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: IREX,IAPT + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISOBIS + REAL, ALLOCATABLE, DIMENSION(:) :: STIS,GAS,UUU,DELBIN,DELTAU + REAL, ALLOCATABLE, DIMENSION(:,:) :: GA2,PRI,SPH,FIXE,PHGAR,STGAR, + 1 SFGAR,FUNKNO,SIGT,SIGS,SIGS1,SIGF,UNGAR + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SSGAR,SAGAR,SDGAR + REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SIGGAR,S0GAR + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: WSIG + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: WSCAT + LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASKI + LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: MASKG + CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HVECT + TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO1 +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(ISOBIS(3,NBISO),IREX(NBMIX),IAPT(NBISO)) + ALLOCATE(MASKI(NBISO),HVECT(NED)) +*---- +* FIND THE NEW ISOTOPE NAMES IN IPLI0. +*---- + CALL LCMLEN(IPLI0,'ISOTOPESUSED',ILONG,ITYLCM) + IF(ILONG.NE.0) THEN + CALL LCMGET(IPLI0,'ISOTOPESUSED',ISOBIS) + ELSE + CALL LCMGET(IPLIB,'ISOTOPESUSED',ISOBIS) + ENDIF + CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED,HVECT) + DO 10 ISO=1,NBISO + WRITE(TEXT4,'(A4)') IHSUF(ISO) + IF(TEXT4.NE.' ') ISOBIS(3,ISO)=IHSUF(ISO) + 10 CONTINUE + CALL LCMPUT(IPLI0,'ISOTOPESUSED',3*NBISO,3,ISOBIS) +*---- +* COMPUTE THE NUMBER OF RESONANT ISOTOPES IN REGION INRS AND THE +* RESONANT ISOTOPE INDEX ASSOCIATED TO EACH ISOTOPE SPECIFICATION. +*---- + NIRES=0 + DO 50 ISO=1,NBISO + IAPT(ISO)=0 + IF((LSHI(ISO).EQ.INRS).AND.(DEN(ISO).NE.0.0)) THEN + DO 20 NRE=1,NREG + IF(MAT(NRE).EQ.MIX(ISO)) GO TO 30 + 20 CONTINUE + GO TO 50 + 30 DO 40 JSO=1,ISO-1 + IF((ISOBIS(1,ISO).EQ.ISOBIS(1,JSO)).AND. + 1 (ISOBIS(2,ISO).EQ.ISOBIS(2,JSO)).AND. + 2 (ISOBIS(3,ISO).EQ.ISOBIS(3,JSO)).AND. + 3 (LSHI(JSO).EQ.INRS).AND. + 4 (DEN(JSO).NE.0.0).AND.(IAPT(JSO).NE.0)) THEN + IAPT(ISO)=IAPT(JSO) + GO TO 50 + ENDIF + 40 CONTINUE + NIRES=NIRES+1 + IAPT(ISO)=NIRES + ENDIF + 50 CONTINUE + WRITE(HCAL,'(1HC,I5.5)') INRS + IF(NIRES.EQ.0) THEN + WRITE(HSMG,'(45HAUTONE: NO RESONANT ISOTOPES IN RESONANT REGI, + 1 9HON NUMBER,I4,7H (HCAL=,A12,2H).)') INRS,HCAL + CALL XABORT(HSMG) + ENDIF + IF(IMPX.GT.0) WRITE(6,'(/35H AUTONE: PERFORMING SELF-SHIELDING , + 1 18HCALCULATION NAMED ,A12,1H.)') HCAL +*---- +* FIND THE NUMBER OF FUEL REGIONS AND THE FUEL REGION INDICES ASSIGNED +* TO EACH RESONANT MIXTURE. +*---- + ALLOCATE(MASKG(NGRP,NIRES)) + IREX(:NBMIX)=0 + DO 60 ISO=1,NBISO + IBM=MIX(ISO) + IF((IBM.GT.0).AND.(IAPT(ISO).NE.0)) IREX(IBM)=1 + 60 CONTINUE + NBNRS=MAXVAL(IREX(:NBMIX)) + IF(NBNRS.NE.1) CALL XABORT('AUTONE: NBNRS=1 EXPECTED.') + IF(IMPX.GE.1) WRITE(6,410) NIRES,NBNRS,INRS +*---- +* DETERMINE WHICH MODERATOR ISOTOPES ARE MIXED WITH RESONANT ONES. +*---- + DO 70 ISO=1,NBISO + IF((IAPT(ISO).EQ.0).AND.(IREX(MIX(ISO)).GT.0)) IAPT(ISO)=NIRES+1 + 70 CONTINUE + IF(IMPX.GT.1) THEN + WRITE(6,'(/48H AUTONE: IDENTIFICATION OF SELF-SHIELDED ISOTOPE, + 1 14HS (0 < IAPT <=,I4,20H) IN RESONANT REGION,I4,1H:)') NIRES, + 2 INRS + WRITE(6,'(33H ISOTOPE IAPT USED NAME...)') + DO ISO=1,NBISO + WRITE(NAME,'(3A4)') ISOBIS(:3,ISO) + WRITE(6,'(1X,I7,5X,I4,2X,A14)') ISO,IAPT(ISO),NAME + ENDDO + ENDIF +* + ALLOCATE(SPH(NIRES,NGRP),FIXE(NIRES,NGRP),PHGAR(NIRES,NGRP), + 1 STGAR(NIRES,NGRP),SFGAR(NIRES,NGRP),SSGAR(NIRES,NL,NGRP), + 2 S0GAR(NIRES,NL,NGRP,NGRP),SAGAR(NIRES,NED,NGRP), + 3 SDGAR(NIRES,NDEL,NGRP),DELTAU(NGRP)) + ALLOCATE(SIGGAR(NBMIX,0:NIRES,NGRP,3),UNGAR(NUN,NGRP)) + ALLOCATE(UUU(LBIN+1),DELBIN(LBIN),STAT=IER_OK) + IF(IER_OK /= 0) CALL XABORT('AUTONE: ALLOCATION PROBLEM(1).') + ALLOCATE(FUNKNO(NUN,LBIN),STAT=IER_OK) + IF(IER_OK /= 0) CALL XABORT('AUTONE: ALLOCATION PROBLEM(2).') + ALLOCATE(SIGT(LBIN,NBISO),STAT=IER_OK) + IF(IER_OK /= 0) CALL XABORT('AUTONE: ALLOCATION PROBLEM(3).') + ALLOCATE(SIGS(LBIN,NBISO),STAT=IER_OK) + IF(IER_OK /= 0) CALL XABORT('AUTONE: ALLOCATION PROBLEM(4).') + ALLOCATE(SIGS1(LBIN,NBISO),STAT=IER_OK) + IF(IER_OK /= 0) CALL XABORT('AUTONE: ALLOCATION PROBLEM(5).') + ALLOCATE(SIGF(LBIN,NBISO),STAT=IER_OK) + IF(IER_OK /= 0) CALL XABORT('AUTONE: ALLOCATION PROBLEM(6).') +*---- +* COMPUTE THE NEUTRON FLUX. +*---- + CALL AUTFLU(IPTRK,IPLIB,IPLI0,IFTRAK,NREG,NUN,NBMIX,NBISO,NIRES, + 1 MAT,VOL,KEYFLX,CDOOR,LEAKSW,IMPX,DEN,MIX,IAPT,IPHASE,NGRP,IGRMIN, + 2 IGRRES,IGRMAX,DIL,TITR,IALTER,DELI,LBIN,NBIN,EBIN,MAXTRA,ISEED, + 3 ITRANC,UUU,FUNKNO,SIGT,SIGS,SIGS1,SIGF,SIGGAR,MASKG) +*---- +* COMPUTE UNGAR. +*---- + UNGAR(:NUN,:NGRP)=0.0 + LLL=0 + DO 110 IG=1,NGRP + GAR0=0.0D0 + DO 90 LI=1,NBIN(IG) + LLL=LLL+1 + IF(LLL.GT.LBIN) CALL XABORT('AUTONE: LBIN OVERFLOW.') + DELBIN(LLL)=UUU(LLL+1)-UUU(LLL) + GAR0=GAR0+DELBIN(LLL) + DO 80 IUN=1,NUN + UNGAR(IUN,IG)=UNGAR(IUN,IG)+FUNKNO(IUN,LLL)*DELBIN(LLL) + 80 CONTINUE + 90 CONTINUE + DO 100 IUN=1,NUN + UNGAR(IUN,IG)=UNGAR(IUN,IG)/REAL(GAR0) + 100 CONTINUE + 110 CONTINUE +*---- +* CONDENSATION OF AUTOLIB FLUX AND OF RESONANT REACTION RATES. +*---- + ALLOCATE(IPISO1(NBISO),GAS(NGRP),GA2(NGRP,NGRP),PRI(MAXTRA,NL)) + CALL LIBIPS(IPLIB,NBISO,IPISO1) + DELTAU(:NGRP)=0.0 + FIXE(:NIRES,:NGRP)=0.0 + PHGAR(:NIRES,:NGRP)=0.0 + STGAR(:NIRES,:NGRP)=0.0 + SFGAR(:NIRES,:NGRP)=0.0 + SSGAR(:NIRES,:NL,:NGRP)=0.0 + S0GAR(:NIRES,:NL,:NGRP,:NGRP)=0.0 + SAGAR(:NIRES,:NED,:NGRP)=0.0 + SDGAR(:NIRES,:NDEL,:NGRP)=0.0 + DO 260 ISO=1,NBISO + IBM=MIX(ISO) + IF(IBM.LE.0) GO TO 260 + IRES=IAPT(ISO) + IF((IRES.GT.0).AND.(IRES.LE.NIRES)) THEN + ! recover infinite dilution values + KPLIB=IPISO1(ISO) ! set ISO-th isotope + CALL LCMGET(KPLIB,'AWR',AWR) + CALL LCMGET(KPLIB,'NTOT0',GAS) + STGAR(IRES,:NGRP)=GAS(:NGRP) + CALL LCMLEN(KPLIB,'NUSIGF',ILENGT,ITYLCM) + IF(ILENGT.GT.0) THEN + CALL LCMGET(KPLIB,'NUSIGF',GAS) + SFGAR(IRES,:NGRP)=GAS(:NGRP) + ENDIF + DO 120 IL=1,NL + CALL XDRLGS(KPLIB,-1,IMPX,IL-1,IL-1,1,NGRP,GAS,GA2,ITYPRO) + S0GAR(IRES,IL,:NGRP,:NGRP)=GA2(:NGRP,:NGRP) + SSGAR(IRES,IL,:NGRP)=GAS(:NGRP) + 120 CONTINUE + DO 125 IED=1,NED + CALL LCMLEN(KPLIB,HVECT(IED),ILENGT,ITYLCM) + IF(ILENGT.GT.0) THEN + CALL LCMGET(KPLIB,HVECT(IED),GAS) + SAGAR(IRES,IED,:NGRP)=GAS(:NGRP) + ENDIF + 125 CONTINUE + DO 130 IDEL=1,NDEL + WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL + CALL LCMLEN(KPLIB,TEXT12,ILENGT,ITYLCM) + IF(ILENGT.GT.0) THEN + CALL LCMGET(KPLIB,TEXT12,GAS) + SDGAR(IRES,IDEL,:NGRP)=GAS(:NGRP) + ENDIF + 130 CONTINUE + ! set elastic scattering information. + DO 135 IL=1,NL + CALL LIBPRI(MAXTRA,DELI,AWR,IALTER,IL-1,NEXT0,PRI(1,IL)) + 135 ENDDO + ! include self-shielded values + LLL=0 + DO 140 IG=1,IGRMIN-1 + LLL=LLL+NBIN(IG) + 140 CONTINUE + ALLOCATE(STIS(LBIN),WSCAT(NGRP,NGRP,NL),WSIG(NGRP,NL)) + WSCAT(:NGRP,:NGRP,:NL)=0.0D0 + WSIG(:NGRP,:NL)=0.0D0 + DO 210 IG=IGRMIN,IGRMAX + SSGAR1=SSGAR(IRES,1,IG) + ABGAR1=STGAR(IRES,IG)-SSGAR(IRES,1,IG) + SFGAR1=SFGAR(IRES,IG) + LABS=ABS(ABGAR1).GT.1.0E-5*ABS(STGAR(IRES,IG)) + VOLTOT=0.0D0 + GAR0=0.0D0 + GAR1=0.0D0 + GAR2=0.0D0 + GAR3=0.0D0 + GAR4=0.0D0 + DO 150 NRE=1,NREG + IF(MAT(NRE).EQ.IBM) VOLTOT=VOLTOT+VOL(NRE) + 150 CONTINUE + DO 190 LI=1,NBIN(IG) + LLL=LLL+1 + IF(LLL.GT.LBIN) CALL XABORT('AUTONE: LBIN OVERFLOW.') + GAR0=GAR0+DELBIN(LLL) + DO 180 NRE=1,NREG + IF(MAT(NRE).NE.IBM) GO TO 180 + IUN=KEYFLX(NRE) + IF(IUN.EQ.0) GO TO 180 + FLUXL=FUNKNO(IUN,LLL)*VOL(NRE)*DELBIN(LLL) + GAR1=GAR1+FLUXL + GAR2=GAR2+SIGT(LLL,ISO)*FLUXL + GAR3=GAR3+SIGS(LLL,ISO)*FLUXL + GAR4=GAR4+SIGF(LLL,ISO)*FLUXL + DO 175 IL=1,NL + STIS(:LBIN)=0.0 + CALL LIBECT(MAXTRA,LLL,PRI(1,IL),UUU(2),DELI,DELBIN,NEXT0,1,MML, + 1 STIS) + LLJ=0 + DO 170 JG=1,NGRP + DO 160 LJ=1,NBIN(JG) + I=LLL-LLJ + IF(I.LE.0) GO TO 175 + LLJ=LLJ+1 + WSCAT(JG,IG,IL)=WSCAT(JG,IG,IL)+SIGS(LLJ,ISO)*STIS(I)* + 1 FUNKNO(IUN,LLJ)*VOL(NRE)*DELBIN(LLJ) ! JG --> IG + 160 CONTINUE + 170 CONTINUE + 175 CONTINUE + 180 CONTINUE + 190 CONTINUE + DELTAU(IG)=REAL(GAR0) + STGAR(IRES,IG)=REAL(GAR2/GAR1) + SSGAR(IRES,1,IG)=REAL(GAR3/GAR1) + SFGAR(IRES,IG)=REAL(GAR4/GAR1) + FIXE(IRES,IG)=DIL(ISO)*DELTAU(IG) + PHGAR(IRES,IG)=REAL(GAR1/(VOLTOT*GAR0)) + DO 205 IL=1,NL + DO 200 JG=1,IG + IF(NBIN(JG).GT.0) THEN + IF(PHGAR(IRES,JG).NE.0.0) THEN + WSCAT(JG,IG,IL)=WSCAT(JG,IG,IL)/(PHGAR(IRES,JG)*VOLTOT* + 1 DELTAU(JG)) + WSIG(JG,IL)=WSIG(JG,IL)+WSCAT(JG,IG,IL) + ELSE + WSCAT(JG,IG,IL)=0.0D0 + ENDIF + ENDIF + 200 CONTINUE + 205 CONTINUE + SSGAR2=SSGAR(IRES,1,IG) + ABGAR2=STGAR(IRES,IG)-SSGAR(IRES,1,IG) + SFGAR2=SFGAR(IRES,IG) + DO IED=1,NED + IF((HVECT(IED).EQ.'NINEL').OR.(HVECT(IED).EQ.'NELAS').OR. + 1 (HVECT(IED).EQ.'N2N').OR.(HVECT(IED).EQ.'N3N').OR. + 2 (HVECT(IED).EQ.'N4N').OR.(HVECT(IED).EQ.'NX').OR. + 3 (HVECT(IED).EQ.'STRD')) THEN + SAGAR(IRES,IED,IG)=SAGAR(IRES,IED,IG)*SSGAR2/SSGAR1 + ELSE + IF(LABS) SAGAR(IRES,IED,IG)=SAGAR(IRES,IED,IG)*ABGAR2/ABGAR1 + ENDIF + ENDDO + DO IDEL=1,NDEL + SDGAR(IRES,IDEL,IG)=SDGAR(IRES,IDEL,IG)*SFGAR2/SFGAR1 + ENDDO + 210 CONTINUE + DO 240 IL=1,NL + DO 230 IG=IGRMIN,IGRMAX + IF(IL.GT.1) SSGAR(IRES,IL,IG)=REAL(WSIG(IG,IL)) + DO 220 JG=IGRMIN,IGRMAX + S0GAR(IRES,IL,JG,IG)=REAL(WSCAT(IG,JG,IL)) + 220 CONTINUE + 230 CONTINUE + 240 CONTINUE + IF(IMPX.GT.3) THEN + WRITE(6,'(//18H AUTONE: ISOTOPE='',3A4,1H''/9X,10HMICROSCOPI, + 1 28HC XS BEFORE SELF-SHIELDING (,I5,9H <= IG <=,I5,1H))') + 2 ISOBIS(:3,ISO),IGRMIN,IGRMAX + WRITE(6,'(/27H CONDENSED LETHARGY WIDTHS:/(1X,1P,10E12.4))') + 1 (DELTAU(IG),IG=1,NGRP) + WRITE(6,'(/25H CONDENSED FIXED SOURCES:/(1X,1P,10E12.4))') + 1 (FIXE(IRES,IG),IG=1,NGRP) + WRITE(6,'(/24H CONDENSED NEUTRON FLUX:/(1X,1P,10E12.4))') + 1 (PHGAR(IRES,IG),IG=1,NGRP) + WRITE(6,'(/46H CONDENSED P0 MICROSCOPIC DIFFUSION CROSS-SECT, + 1 5HIONS:/(1X,1P,10E12.4))') (SSGAR(IRES,1,IG),IG=1,NGRP) + WRITE(6,'(/46H CONDENSED P0 MICROSCOPIC DIFFUSION CROSS-SECT, + 1 13HIONS (CHECK):/(1X,1P,10E12.4))') (WSIG(IG,1),IG=1,NGRP) + WRITE(6,'(/44H CONDENSED MICROSCOPIC TOTAL CROSS-SECTIONS:/ + 1 (1X,1P,10E12.4))') (STGAR(IRES,IG),IG=1,NGRP) + WRITE(6,'(/46H CONDENSED MICROSCOPIC FISSION CROSS-SECTIONS:/ + 1 (1X,1P,10E12.4))') (SFGAR(IRES,IG),IG=1,NGRP) + ENDIF + DEALLOCATE(WSIG,WSCAT,STIS) + ENDIF + 260 CONTINUE + DEALLOCATE(PRI,GA2,GAS,IPISO1) +*---- +* COMPUTE THE SPH FACTORS. +*---- + SPH(:NIRES,:NGRP)=1.0 + IF(KSPH.GT.0) THEN + CALL LCMGET(IPLI0,'DELTAU',DELTAU) + CALL AUTSPH(IPLI0,IPTRK,IFTRAK,NREG,NUN,NBMIX,NBISO,NIRES,NL, + 1 NED,NDEL,HCAL,MAT,VOL,KEYFLX,CDOOR,LEAKSW,IMPX,DEN,MIX,IAPT, + 2 ITRANC,IPHASE,NGRP,MASKG,IREX,TITR,SIGGAR,UNGAR,PHGAR,STGAR, + 3 SFGAR,SSGAR,S0GAR,SAGAR,SDGAR,DELTAU,SPH) + ENDIF +*---- +* PRINT SELF-SHIELDED MICROSCOPIC CROSS SECTIONS. +*---- + IF(IMPX.GT.1) THEN + DO 300 ISO=1,NBISO + IBM=MIX(ISO) + IF(IBM.LE.0) GO TO 300 + IRES=IAPT(ISO) + IF((IRES.GT.0).AND.(IRES.LE.NIRES)) THEN + WRITE(6,'(//18H AUTONE: ISOTOPE='',3A4,1H''/9X,10HMICROSCOPI, + 1 20HC SELF-SHIELDED XS (,I5,9H <= IG <=,I5,1H))') + 2 ISOBIS(:3,ISO),IGRMIN,IGRMAX + IF(KSPH.GT.0) THEN + WRITE(6,'(/13H SPH FACTORS:/(1X,1P,10E12.4))') + 1 (SPH(IRES,IG),IG=IGRMIN,IGRMAX) + ENDIF + WRITE(6,'(/27H CONDENSED FINE STRUCTURES:/(1X,1P,10E12.4))') + 1 (PHGAR(IRES,IG),IG=IGRMIN,IGRMAX) + WRITE(6,'(/46H CONDENSED P0 MICROSCOPIC DIFFUSION CROSS-SECT, + 1 5HIONS:/(1X,1P,10E12.4))') (SSGAR(IRES,1,IG),IG=IGRMIN,IGRMAX) + WRITE(6,'(/44H CONDENSED MICROSCOPIC TOTAL CROSS-SECTIONS:/ + 1 (1X,1P,10E12.4))') (STGAR(IRES,IG),IG=IGRMIN,IGRMAX) + WRITE(6,'(/46H CONDENSED MICROSCOPIC FISSION CROSS-SECTIONS:/ + 1 (1X,1P,10E12.4))') (SFGAR(IRES,IG),IG=IGRMIN,IGRMAX) + IF(NL.GT.1) THEN + WRITE(6,'(/44H CONDENSED P1 MICROSCOPIC DIFFUSION CROSS-SE, + 1 7HCTIONS:/(1X,1P,10E12.4))') (SSGAR(IRES,2,IG),IG=IGRMIN, + 2 IGRMAX) + ENDIF + IF(IMPX.GT.2) THEN + DO 290 IL=1,NL + WRITE(6,'(/12H CONDENSED P,I2.2,23H MICROSCOPIC TRANSFER C, + 1 14HROSS-SECTIONS:)') IL-1 + DO 280 IG=IGRMIN,IGRMAX + JGRMIN=NGRP+1 + JGRMAX=0 + DO 270 JG=1,NGRP + IF(S0GAR(IRES,IL,JG,IG).NE.0.0) THEN + JGRMIN=MIN(JGRMIN,JG) + JGRMAX=MAX(JGRMAX,JG) + ENDIF + 270 CONTINUE + WRITE(6,420) (IG,JG,S0GAR(IRES,IL,JG,IG),JG=JGRMIN,JGRMAX) + 280 CONTINUE + 290 CONTINUE + ENDIF + ENDIF + 300 CONTINUE + ENDIF + DEALLOCATE(SIGF,SIGS1,SIGS,SIGT,FUNKNO,DELBIN,UUU) + DEALLOCATE(UNGAR,SIGGAR) +*---- +* CREATE THE SELF-SHIELDED INTERNAL LIBRARY USING A SIMPLE +* TRANSCRIPTION OF THE SELF-SHIELDED CROSS SECTIONS. +*---- + CALL KDRCPU(TK1) +* SIMPLE TRANSCRIPTION OF THE SELF-SHIELDED CROSS SECTIONS. + DO 310 ISO=1,NBISO + MASKI(ISO)=(IAPT(ISO).GT.0).AND.(IAPT(ISO).LE.NIRES) + 310 CONTINUE + DO 330 ISO=1,NBISO + IF(MASKI(ISO)) THEN + DO 320 JSO=ISO+1,NBISO + IF((ISOBIS(1,ISO).EQ.ISOBIS(1,JSO)).AND. + 1 (ISOBIS(2,ISO).EQ.ISOBIS(2,JSO)).AND. + 2 (ISOBIS(3,ISO).EQ.ISOBIS(3,JSO))) MASKI(JSO)=.FALSE. + 320 CONTINUE + ENDIF + 330 CONTINUE + CALL USSIN1(IPLI0,IPLIB,NGRP,NBMIX,NBISO,NIRES,NBNRS,NL,NED,NDEL, + 1 IREX,IMPX,ISONAM,ISOBIS,MIX,IAPT,MASKI,SPH,PHGAR,STGAR,SFGAR, + 2 SSGAR,S0GAR,SAGAR,SDGAR) + CALL KDRCPU(TK2) + IF(IMPX.GT.1) WRITE(6,'(/36H AUTONE: CPU TIME SPENT TO BUILD THE, + 1 33H SELF-SHIELDED INTERNAL LIBRARY =,F8.1,8H SECOND.)') TK2-TK1 +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(DELTAU,SDGAR,SAGAR,S0GAR,SSGAR,SFGAR,STGAR,PHGAR,SPH) + DEALLOCATE(MASKG,HVECT,MASKI) + DEALLOCATE(IAPT,IREX,ISOBIS) + RETURN +* + 410 FORMAT(/48H AUTONE: NUMBER OF CORRELATED RESONANT ISOTOPES=,I4/9X, + 1 35HNUMBER OF CORRELATED FUEL MIXTURES=,I4,19H IN RESONANT REGION, + 2 I3) + 420 FORMAT(1P,3X,I4,4H -->,I4,2H :,E12.4,3X,I4,4H -->,I4,2H :,E12.4, + 1 3X,I4,4H -->,I4,2H :,E12.4,3X,I4,4H -->,I4,2H :,E12.4, + 2 3X,I4,4H -->,I4,2H :,E12.4,3X,I4,4H -->,I4,2H :,E12.4) + END -- cgit v1.2.3