*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