*DECK AUTIT2 SUBROUTINE AUTIT2(IPTRK,IFTRAK,IPSYS,MAXTRA,KNORM,NUN,LBIN,NREG, 1 NBMIX,NBISO,MAT,VOL,KEYFLX,NIRES,IAPT,CDOOR,LEAKSW,TITR,IMPX, 2 CONC,SIGS,SIGT,SIGS1,DIL,PRI,UUU,DELI,ITRANC,NEXT,III,FUNKNO) * *----------------------------------------------------------------------- * *Purpose: * Solution of the multigroup neutron flux for a non-pij 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 * IPTRK pointer to the tracking (L_TRACK signature). * IFTRAK file unit number used to store the tracks. * IPSYS pointer to the system LCM object. * MAXTRA maximum number of elements in vector PRI. * KNORM type of cp normalization. * NUN number of unknowns in a single energy group. * LBIN number of energy groups. * NREG number of regions. * NBMIX number of mixtures in the internal library. * NBISO number of distinct isotopes. * MAT index-number of the mixture type assigned to each volume. * VOL volumes. * KEYFLX position of average fluxes in the unknown vector. * NIRES number of correlated resonant isotopes. * IAPT resonant isotope index associated with isotope I. Mixed * moderator if IAPT(I)=NIRES+1. Out-of-fuel isotope if * IAPT(I)=0. * CDOOR name of the geometry/solution operator. * LEAKSW leakage flag (LEAKSW=.true. if neutron leakage through * external boundary is present). * TITR title. * IMPX print flag (equal to zero for no print). * CONC number densities of each isotope in each mixture. * SIGS P0 scattering microscopic x-s. * SIGT total microscopic x-s. * SIGS1 P1 scattering microscopic x-s. * DIL microscopic dilution cross section of each isotope. * PRI info to rebuild the SCAT matrix. * UUU lethargy limits of the groups. * DELI elementary lethargy width. * ITRANC type of transport correction. * NEXT used in subroutine LIBECT. * III offset in PRI array. * *Parameters: output * FUNKNO neutron flux per unit lethargy. * *----------------------------------------------------------------------- * USE GANLIB USE DOORS_MOD *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPTRK,IPSYS INTEGER IFTRAK,MAXTRA,KNORM,NUN,LBIN,NREG,NBMIX,NBISO,MAT(NREG), 1 NIRES,IAPT(NBISO),KEYFLX(NREG),IMPX,ITRANC,NEXT(NBISO), 2 III(NBISO+1) REAL VOL(NREG),CONC(NBMIX,NBISO),SIGS(LBIN,NBISO), 1 SIGT(LBIN,NBISO),SIGS1(LBIN,NBISO),DIL(NBISO),PRI(MAXTRA), 2 UUU(LBIN+1),DELI,FUNKNO(NUN,LBIN) LOGICAL LEAKSW CHARACTER CDOOR*12,TITR*72 *---- * LOCAL VARIABLES *---- INTEGER, PARAMETER :: NGEFF=1 TYPE(C_PTR) JPSYS,KPSYS,KPSOU1(NGEFF),KPSOU2(NGEFF) INTEGER NGIND(NGEFF),NBS2(NGEFF) CHARACTER HSMG*131 LOGICAL LSOUR *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: NLET,NPSYS REAL, ALLOCATABLE, DIMENSION(:) :: DEL,SIGG,SIGTOT,SIGWIN,STIS, 1 SUNKNO REAL, ALLOCATABLE, DIMENSION(:,:) :: STR *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(NLET(NBMIX),NPSYS(LBIN)) ALLOCATE(DEL(LBIN),SIGG(0:NBMIX),SIGTOT(0:NBMIX),SIGWIN(0:NBMIX), 1 STR(LBIN,NBMIX),STIS(LBIN),SUNKNO(NUN)) * JPSYS=LCMLID(IPSYS,'GROUP',LBIN) DO 10 LLL=1,LBIN DEL(LLL)=UUU(LLL+1)-UUU(LLL) 10 CONTINUE DO 60 LLL=1,LBIN NPSYS(LLL)=LLL *---- * COMPUTE THE TOTAL SCATTERING CROSS SECTIONS. *---- SIGTOT(0)=0.0 DO 20 M=1,NBMIX SIGTOT(M)=0.0 DO 15 K=1,NBISO IF(ITRANC.NE.0) SIGTOT(M)=SIGTOT(M)-CONC(M,K)*SIGS1(LLL,K) SIGTOT(M)=SIGTOT(M)+CONC(M,K)*(DIL(K)+SIGT(LLL,K)) 15 CONTINUE 20 CONTINUE IF(IMPX.GE.9) THEN WRITE (6,'(//45H AUTIT2: TOTAL MACROSCOPIC CROSS SECTIONS IN , 1 5HGROUP,I5,1H:/)') LLL WRITE (6,'(1X,1P,10E13.5)') (SIGTOT(MAT(NRE)),NRE=1,NREG) ENDIF *---- * COMPUTE THE P0 WITHIN-GROUP SCATTERING CROSS SECTIONS. *---- SIGWIN(0:NBMIX)=0.0 DO 50 K=1,NBISO IF((IAPT(K).GT.0).AND.(IAPT(K).LE.NIRES)) THEN CALL LIBECT(MAXTRA,LLL,PRI,UUU(2),DELI,DEL,NEXT(K),III(K),MML, 1 STIS) DO 30 M=1,NBMIX SIGWIN(M)=SIGWIN(M)+CONC(M,K)*STIS(1)*SIGS(LLL,K) 30 CONTINUE ENDIF IF(ITRANC.NE.0) THEN DO 40 M=1,NBMIX SIGWIN(M)=SIGWIN(M)-CONC(M,K)*SIGS1(LLL,K) 40 CONTINUE ENDIF 50 CONTINUE IF(IMPX.GE.10) THEN WRITE (6,'(//45H P0 WITHIN-GROUP SCATTERING MACROSCOPIC CROSS, 1 18H SECTIONS IN GROUP,I5,1H:/)') LLL WRITE (6,'(1X,1P,10E13.5)') (SIGWIN(MAT(NRE)),NRE=1,NREG) ENDIF * KPSYS=LCMDIL(JPSYS,LLL) CALL LCMPUT(KPSYS,'DRAGON-TXSC',NBMIX+1,2,SIGTOT(0)) CALL LCMPUT(KPSYS,'DRAGON-S0XSC',NBMIX+1,2,SIGWIN(0)) 60 CONTINUE *---- * COMPUTE THE GROUPWISE RESPONSE MATRICES. *---- NANI=1 NW=0 NALBP=0 ISTRM=1 CALL DOORAV (CDOOR,JPSYS,NPSYS,IPTRK,IFTRAK,IMPX,LBIN,NREG, > NBMIX,NANI,NW,MAT,VOL,KNORM,LEAKSW,TITR,NALBP,ISTRM) *---- * COMPUTE THE ELASTIC SLOWING-DOWN SOURCE. *---- DO 160 LLL=1,LBIN DO M=1,NBMIX NLET(M)=1 STR(:LBIN,M)=0.0 ENDDO DO 90 K=1,NBISO IF((IAPT(K).GT.0).AND.(IAPT(K).LE.NIRES)) THEN CALL LIBECT(MAXTRA,LLL,PRI,UUU(2),DELI,DEL,NEXT(K),III(K),MML, 1 STIS) DO 80 M=1,NBMIX AUX=CONC(M,K) IF(AUX.EQ.0.) GOTO 80 NLET(M)=MAX(NLET(M),MML) DO 70 MM=1,MML LLJ=LLL-MM+1 STR(MM,M)=STR(MM,M)+AUX*STIS(MM)*SIGS(LLJ,K)*DEL(LLJ)/DEL(LLL) 70 CONTINUE 80 CONTINUE ENDIF 90 CONTINUE *---- * DILUTION SOURCE. *---- SIGG(0:NBMIX)=0.0 DO 110 IBM=1,NBMIX DO 100 K=1,NBISO IF((IAPT(K).EQ.0).OR.(IAPT(K).EQ.NIRES+1)) THEN SIGG(IBM)=SIGG(IBM)+CONC(IBM,K)*SIGS(LLL,K) ELSE SIGG(IBM)=SIGG(IBM)+CONC(IBM,K)*DIL(K) ENDIF 100 CONTINUE 110 CONTINUE SUNKNO(:NUN)=0.0 CALL DOORS(CDOOR,IPTRK,NBMIX,0,NUN,SIGG,SUNKNO) *---- * SCATTERING SOURCE. *---- DO 130 MM=2,LLL SIGG(0:NBMIX)=0.0 LSOUR=.FALSE. DO 120 IBM=1,NBMIX IF(MM.LE.NLET(IBM)) THEN LSOUR=.TRUE. SIGG(IBM)=STR(MM,IBM) ENDIF 120 CONTINUE IF(LSOUR) CALL DOORS(CDOOR,IPTRK,NBMIX,0,NUN,SIGG,SUNKNO, > FUNKNO(1,LLL-MM+1)) 130 CONTINUE IF(IMPX.GE.8) WRITE(6,'(7H GROUP=,I5,7H S=,2X,1P,9D12.4/ 1 (21X,9D12.4))') LLL,(SUNKNO(KEYFLX(NRE)),NRE=1,NREG) *---- * FLUX SOLUTION. *---- IDIR=0 NGIND(1)=LLL NBS2(1)=0 KPSOU1(1)=C_NULL_PTR KPSOU2(1)=C_NULL_PTR IMPX2=MAX(0,IMPX-5) KPSYS=LCMDIL(JPSYS,LLL) IF(CDOOR.EQ.'SYBIL') THEN CALL SYBILF(KPSYS,IPTRK,IFTRAK,IMPX2,NGEFF,NGIND,IDIR,NREG, 1 NUN,MAT,VOL,FUNKNO(1,LLL),SUNKNO,TITR) ELSE IF(CDOOR.EQ.'SN') THEN CALL SNF(KPSYS,IPTRK,IFTRAK,IMPX2,NGEFF,NGIND,IDIR,NREG, 1 NBMIX,NUN,MAT,VOL,KEYFLX,FUNKNO(1,LLL),SUNKNO,TITR, 2 NBS2,KPSOU1,KPSOU2) ELSE WRITE(HSMG,'(13HAUTIT2: DOOR ,A,20H IS NOT IMPLEMENTED.)') 1 TRIM(CDOOR) CALL XABORT(HSMG) ENDIF IF(IMPX.GE.8) WRITE(6,'(7H GROUP=,I5,7H FLUX=,2X,1P,9E12.4/ 1 (21X,9E12.4))') LLL,(FUNKNO(KEYFLX(NRE),LLL),NRE=1,NREG) 160 CONTINUE *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(SUNKNO,STIS,STR,SIGWIN,SIGTOT,SIGG,DEL) DEALLOCATE(NPSYS,NLET) RETURN END