*DECK MACXSR SUBROUTINE MACXSR(MAXFIS,NGROUP,NBMIX,NIFISS,NANISO,NDELG,NTYPE, > XSTOTL,XSTOT1,XSFISS,XSSPEC,XSFIXE,XSTRAN, > XSDIFF,XSNFTO,XSH,XSSCAT,LOLDXS,LNEWXS,CARLIR, > LADD,LUPD,IPRINT,ISCATA,XSNUDL,XSCHDL,XSDIFX, > XSDIFY,XSDIFZ,XSOVRV,XSINT0,XSINT1,HADF,XADF) * *----------------------------------------------------------------------- * *Purpose: * Read cross sections from input file. * *Copyright: * Copyright (C) 2006 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): G. Marleau * *Parameters: input * MAXFIS set to max(1,NIFISS). * NGROUP number of energy groups. * NBMIX maximum number of mixtures. * NIFISS number of fissile isotopes. * NANISO maximum Legendre order: * =1 isotropic collision; * =2 linearly anisotropic collision. * NDELG number of precursor groups for delayed neutrons. * NTYPE number of boundary regions types for ADF calculations. * LOLDXS flag for cross section type already present on the macrolib. * CARLIR last string read. * LADD flag (true) for reading invcrementsçal XS. * LUPD flag (true) for updating XS. * IPRINT print level. * *Parameters: input/output * XSTOTL P0 total cross section of mixture. * XSTOT1 P1 total cross section of mixture. * XSFISS nu*fission cross section of mixture. * XSNFTO fission cross section of mixture. * XSSPEC fission spectrum. * XSFIXE fixe sources. * XSTRAN transport correction. * XSDIFF isotropic diffusion coefficient. * XSH power factor. * XSSCAT scattering cross section of mixture/group. * XSNUDL delayed nu*fission cross section of mixture. * XSCHDL delayed-neutron fission spectrum. * XSDIFX x-directed diffusion coefficients. * XSDIFY y-directed diffusion coefficients. * XSDIFZ z-directed diffusion coefficients. * XSOVRV reciprocal neutron velocities. * XSINT0 P0 volume-integrated flux of mixture. * XSINT1 P1 volume-integrated flux of mixture. * *Parameters: output * LNEWXS flag for cross section modified. * ISCATA check for scattering anisotropy. * HADF names of the boundary flux types. * XADF averaged fluxes in boundary regions. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- PARAMETER (NCXST=18) INTEGER MAXFIS,NGROUP,NBMIX,NIFISS,NANISO,NDELG,IPRINT, > ISCATA(NANISO) REAL XSTOTL(NBMIX,NGROUP),XSTOT1(NBMIX,NGROUP), > XSFISS(NBMIX,MAXFIS,NGROUP),XSSPEC(NBMIX,MAXFIS,NGROUP), > XSFIXE(NBMIX,NGROUP),XSTRAN(NBMIX,NGROUP), > XSDIFF(NBMIX,NGROUP),XSNFTO(NBMIX,NGROUP), > XSH(NBMIX,NGROUP),XSSCAT(NGROUP,NBMIX,NANISO,NGROUP), > XSNUDL(NBMIX,MAXFIS,NDELG,NGROUP), > XSCHDL(NBMIX,MAXFIS,NDELG,NGROUP), > XSDIFX(NBMIX,NGROUP),XSDIFY(NBMIX,NGROUP), > XSDIFZ(NBMIX,NGROUP),XSOVRV(NBMIX,NGROUP), > XSINT0(NBMIX,NGROUP),XSINT1(NBMIX,NGROUP), > XADF(NBMIX,NGROUP,NTYPE) LOGICAL LOLDXS(NCXST),LNEWXS(NCXST),LADD,LUPD CHARACTER HADF(NTYPE)*8,CARLIR*12 *---- * LOCAL VARIABLES *---- PARAMETER (IUNOUT=6) CHARACTER CARXST(NCXST)*6 DOUBLE PRECISION DBLINP *---- * ALLOCATABLE ARRAYS *---- LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: LINIXS *---- * SCRATCH STORAGE ALLOCATION * LINIXS flag for cross section read per mixture. *---- ALLOCATE(LINIXS(NCXST,NBMIX)) * HADF(:)=' ' XADF(:,:,:)=0.0 MATNUM=0 DO 200 IM=1,NBMIX DO 210 IT=1,NCXST LINIXS(IT,IM)=.TRUE. 210 CONTINUE 200 CONTINUE *---- * START READING KEYWORDS *---- ITYPE=0 1000 CONTINUE CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLINP) 1001 IF(ITYPLU.NE.3) CALL XABORT('MACXSR: READ ERROR - CHARACTER VARI' > //'ABLE EXPECTED: TOTA, NUSI, FIXE, TRAN, DIFF, CHI, SCAT, MIX ') IF((CARLIR.EQ.'NTOT0').OR.(CARLIR.EQ.'TOTAL')) THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(1,MATNUM)) THEN LINIXS(1,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: TOTAL XS FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(1)=.TRUE. *---- * TOTAL XS *---- DO 100 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: TOTAL XS') IF(LADD) FLOTT=FLOTT+XSTOTL(MATNUM,IGROUP) XSTOTL(MATNUM,IGROUP)=FLOTT 100 CONTINUE ELSE IF(CARLIR.EQ.'NUSIGF') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(NIFISS.EQ.0)CALL XABORT('MACXSR: NIFISS EXPECTED GREATER TH' > //'AN ZERO') IF(LINIXS(2,MATNUM)) THEN LINIXS(2,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: NUSIGF FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(2)=.TRUE. *---- * NUSIGF XS *---- DO 110 IFIS=1,NIFISS DO 120 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR' > //'IABLE EXPECTED: NUSIGF') IF(LADD) FLOTT=FLOTT+XSFISS(MATNUM,IFIS,IGROUP) XSFISS(MATNUM,IFIS,IGROUP)=FLOTT 120 CONTINUE 110 CONTINUE ELSE IF(CARLIR.EQ.'FIXE') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(3,MATNUM)) THEN LINIXS(3,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: FIXE FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(3)=.TRUE. *---- * FIXED SOURCES *---- DO 130 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: FIXE') IF(LADD) FLOTT=FLOTT+XSFIXE(MATNUM,IGROUP) XSFIXE(MATNUM,IGROUP)=FLOTT 130 CONTINUE ELSE IF(CARLIR.EQ.'TRANC') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(6,MATNUM)) THEN LINIXS(6,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: TRANC FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(6)=.TRUE. *---- * TRANSPORT CORRECTION *---- DO 140 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: TRANC') IF(LADD) FLOTT=FLOTT+XSTRAN(MATNUM,IGROUP) XSTRAN(MATNUM,IGROUP)=FLOTT 140 CONTINUE ELSE IF(CARLIR.EQ.'DIFF') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(7,MATNUM)) THEN LINIXS(7,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: DIFF FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(7)=.TRUE. *---- * ISOTROPIC DIFFUSION COEFFICIENT *---- DO 145 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: DIFF') IF(LADD) FLOTT=FLOTT+XSDIFF(MATNUM,IGROUP) XSDIFF(MATNUM,IGROUP)=FLOTT 145 CONTINUE ELSE IF(CARLIR.EQ.'DIFFX') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(10,MATNUM)) THEN LINIXS(10,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: DIFFX FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(10)=.TRUE. *---- * X-DIRECTED DIFFUSION COEFFICIENT *---- DO IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: DIFFX') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR DIFFX') XSDIFX(MATNUM,IGROUP)=FLOTT ENDDO ELSE IF(CARLIR.EQ.'DIFFY') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(11,MATNUM)) THEN LINIXS(11,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: DIFFY FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(11)=.TRUE. *---- * Y-DIRECTED DIFFUSION COEFFICIENT *---- DO IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: DIFFY') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR DIFFY') XSDIFY(MATNUM,IGROUP)=FLOTT ENDDO ELSE IF(CARLIR.EQ.'DIFFZ') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(12,MATNUM)) THEN LINIXS(12,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: DIFFZ FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(12)=.TRUE. *---- * Z-DIRECTED DIFFUSION COEFFICIENT *---- DO IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: DIFFZ') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR DIFFZ') XSDIFZ(MATNUM,IGROUP)=FLOTT ENDDO ELSE IF(CARLIR.EQ.'NUSIGD') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(NDELG.EQ.0)CALL XABORT('MACXSR: NDG EXPECTED GREATER THAN' > //' ZERO') IF(LINIXS(13,MATNUM)) THEN LINIXS(13,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: NUSIGD FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(13)=.TRUE. *---- * DELAYED-NEUTRON NU*FISSION CROSS SECTIONS *---- DO 12 IFIS=1,NIFISS DO 11 IDELG=1,NDELG DO 10 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR' > //'IABLE EXPECTED: NUSIGD ') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR NUSIGD') XSNUDL(MATNUM,IFIS,IDELG,IGROUP)=FLOTT 10 CONTINUE 11 CONTINUE 12 CONTINUE ELSE IF(CARLIR.EQ.'CHDL') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(NDELG.EQ.0)CALL XABORT('MACXSR: NDG EXPECTED GREATER THAN' > //' ZERO') IF(LINIXS(14,MATNUM)) THEN LINIXS(14,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: CHDL FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(14)=.TRUE. *---- * DELAYED-NEUTRON FISSION SPECTRUM *---- DO 22 IFIS=1,NIFISS DO 21 IDELG=1,NDELG DO 20 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR' > //'IABLE EXPECTED: CHDL ') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR CHDL') XSCHDL(MATNUM,IFIS,IDELG,IGROUP)=FLOTT 20 CONTINUE 21 CONTINUE 22 CONTINUE ELSE IF(CARLIR.EQ.'OVERV') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(15,MATNUM)) THEN LINIXS(15,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: OVERV FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(15)=.TRUE. *---- * RECIPROCAL NEUTRON VELOCITY *---- DO IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: OVERV') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR OVERV') XSOVRV(MATNUM,IGROUP)=FLOTT ENDDO ELSE IF(CARLIR.EQ.'FLUX-INTG') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(17,MATNUM)) THEN LINIXS(17,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: FLUX-INTG FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(17)=.TRUE. *---- * P0 VOLUME-INTEGRATED FLUX *---- DO IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: FLUX-INTG') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR FLUX-IN' > //'TG') XSINT0(MATNUM,IGROUP)=FLOTT ENDDO ELSE IF(CARLIR.EQ.'FLUX-INTG-P1') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(18,MATNUM)) THEN LINIXS(18,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: FLUX-INTG-P1 FOR THIS MATERIAL ALREADY ' > //'READ') ENDIF LNEWXS(18)=.TRUE. *---- * P1 VOLUME-INTEGRATED FLUX *---- DO IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: FLUX-INTG-P1') IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR FLUX-IN' > //'TG-P1') XSINT1(MATNUM,IGROUP)=FLOTT ENDDO ELSE IF(CARLIR.EQ.'H-FACTOR') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(8,MATNUM)) THEN LINIXS(8,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: H-FACTOR FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(8)=.TRUE. *---- * POWER FACTOR *---- DO 146 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: H-FACTOR') IF(LADD) FLOTT=FLOTT+XSH(MATNUM,IGROUP) XSH(MATNUM,IGROUP)=FLOTT 146 CONTINUE ELSE IF(CARLIR.EQ.'NTOT1') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(9,MATNUM)) THEN LINIXS(9,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: P1 TOTAL XS FOR THIS MATERIAL ALREADY R' > //'EAD') ENDIF LNEWXS(9)=.TRUE. *---- * P1 TOTAL XS *---- DO 147 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: P1 TOTAL XS') IF(LADD) FLOTT=FLOTT+XSTOT1(MATNUM,IGROUP) XSTOT1(MATNUM,IGROUP)=FLOTT 147 CONTINUE ELSE IF(CARLIR.EQ.'CHI') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(NIFISS.EQ.0)CALL XABORT('MACXSR: NIFISS EXPECTED GREATER TH' > //'AN ZERO') IF(LINIXS(4,MATNUM)) THEN LINIXS(4,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: CHI FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(4)=.TRUE. *---- * FISSION SPECTRUM *---- DO 150 IFIS=1,NIFISS DO 160 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR' > //'IABLE EXPECTED: CHI ') IF(LADD) FLOTT=FLOTT+XSSPEC(MATNUM,IFIS,IGROUP) XSSPEC(MATNUM,IFIS,IGROUP)=FLOTT 160 CONTINUE 150 CONTINUE ELSE IF(CARLIR.EQ.'NFTOT') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(16,MATNUM)) THEN LINIXS(16,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: NFTOT FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(16)=.TRUE. *---- * FISSION XS *---- DO 155 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA' > //'BLE EXPECTED: NFTOT') IF(LADD) FLOTT=FLOTT+XSNFTO(MATNUM,IGROUP) XSNFTO(MATNUM,IGROUP)=FLOTT 155 CONTINUE ELSE IF(CARLIR.EQ.'SCAT') THEN IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED') IF(LINIXS(5,MATNUM)) THEN LINIXS(5,MATNUM)=.FALSE. ELSE CALL XABORT('MACXSR: SCATT XS FOR THIS MATERIAL ALREADY READ') ENDIF LNEWXS(5)=.TRUE. *---- * SCATTERING XS: XSSCAT(JGROUP,MATNUM,JANS,IGROUP) WHERE IGROUP IS * THE SECONDARY GROUP. *---- DO 170 JANS=1,NANISO ISCATA(JANS)=2 DO 180 IGROUP=1,NGROUP *---- * READ NUMBER OF GROUPS AND FIRST GROUP *---- CALL REDGET(ITYPLU,ING,REALIR,CARLIR,DBLINP) IF(ITYPLU.NE.1) THEN CALL XABORT('MACXSR: READ ERROR - INTEGER VARIABLE EXPEC' > //'TED FOR SCAT: NGSCAT ') ENDIF CALL REDGET(ITYPLU,IFG,REALIR,CARLIR,DBLINP) IF(ITYPLU.NE.1) CALL XABORT('MACXSR: READ ERROR - INTEGER ' > //'VARIABLE EXPECTED FOR SCAT: NFSCAT') *---- * READ SCATTERING XS *---- DO 190 JGROUP=NGROUP,1,-1 IF((JGROUP.GT.IFG).OR.(JGROUP.LE.(IFG-ING))) THEN IF(.NOT.LADD) XSSCAT(JGROUP,MATNUM,JANS,IGROUP)=0.0 ELSE CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL' > //' VARIABLE EXPECTED: SCAT') IF(LADD) FLOTT=FLOTT+XSSCAT(JGROUP,MATNUM,JANS,IGROUP) XSSCAT(JGROUP,MATNUM,JANS,IGROUP)=FLOTT ENDIF 190 CONTINUE 180 CONTINUE 170 CONTINUE ELSE IF(CARLIR.EQ.'ADF') THEN CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.3) CALL XABORT('MACXSR: READ ERROR - CHARACTER ' > //'VARIABLE EXPECTED: HADF') ITYPE=ITYPE+1 IF(ITYPE.GT.NTYPE) CALL XABORT('MACXSR: NTYPE OVERFLOW.') IF(HADF(ITYPE).EQ.' ') THEN HADF(ITYPE)=CARLIR(:8) ELSE IF(CARLIR(:8).NE.HADF(ITYPE)) THEN CALL XABORT('MACXSR: READ ERROR - ADF NAME '//HADF(ITYPE)// 1 ' EXPECTED.') ENDIF DO 205 IGROUP=1,NGROUP CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP) IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR' > //'IABLE EXPECTED: XADF ') XADF(MATNUM,IGROUP,ITYPE)=FLOTT 205 CONTINUE ELSE IF(.NOT. LUPD .AND. MATNUM.GT.0 ) THEN *---- * RESET XS THAT WERE NOT READ FOR THIS MATERIAL TO 0.0 *---- IF(LINIXS(1,MATNUM).AND.LOLDXS(1)) THEN LNEWXS(1)=.TRUE. DO 300 IGG=1,NGROUP XSTOTL(MATNUM,IGG)=0.0 300 CONTINUE ENDIF IF(LINIXS(2,MATNUM).AND.LOLDXS(2)) THEN LNEWXS(2)=.TRUE. DO 310 IGG=1,NGROUP DO 320 IFS=1,NIFISS XSFISS(MATNUM,IFS,IGG)=0.0 320 CONTINUE 310 CONTINUE ENDIF IF(LINIXS(3,MATNUM).AND.LOLDXS(3)) THEN LNEWXS(3)=.TRUE. DO 330 IGG=1,NGROUP XSFIXE(MATNUM,IGG)=0.0 330 CONTINUE ENDIF IF(LINIXS(4,MATNUM).AND.LOLDXS(4)) THEN LNEWXS(4)=.TRUE. DO 340 IGG=1,NGROUP DO 350 IFS=1,NIFISS XSSPEC(MATNUM,IFS,IGG)=0.0 350 CONTINUE 340 CONTINUE ENDIF IF(LINIXS(5,MATNUM).AND.LOLDXS(5)) THEN LNEWXS(5)=.TRUE. DO 360 JANS=1,NANISO IF(ISCATA(JANS).GE.1) THEN ISCATA(JANS)=2 DO 370 IGG=1,NGROUP DO 380 JGG=1,NGROUP XSSCAT(JGG,MATNUM,JANS,IGG)=0.0 380 CONTINUE 370 CONTINUE ENDIF 360 CONTINUE ENDIF IF(LINIXS(6,MATNUM).AND.LOLDXS(6)) THEN LNEWXS(6)=.TRUE. DO 390 IGG=1,NGROUP XSTRAN(MATNUM,IGG)=0.0 390 CONTINUE ENDIF IF(LINIXS(7,MATNUM).AND.LOLDXS(7)) THEN LNEWXS(7)=.TRUE. DO 400 IGG=1,NGROUP XSDIFF(MATNUM,IGG)=0.0 400 CONTINUE ENDIF IF(LINIXS(8,MATNUM).AND.LOLDXS(8)) THEN LNEWXS(8)=.TRUE. DO 410 IGG=1,NGROUP XSH(MATNUM,IGG)=0.0 410 CONTINUE ENDIF IF(LINIXS(9,MATNUM).AND.LOLDXS(9)) THEN LNEWXS(9)=.TRUE. DO 420 IGG=1,NGROUP XSTOT1(MATNUM,IGG)=0.0 420 CONTINUE ENDIF IF(LINIXS(10,MATNUM).AND.LOLDXS(10)) THEN LNEWXS(10)=.TRUE. DO 430 IGG=1,NGROUP XSDIFX(MATNUM,IGG)=0.0 430 CONTINUE ENDIF IF(LINIXS(11,MATNUM).AND.LOLDXS(11)) THEN LNEWXS(11)=.TRUE. DO 440 IGG=1,NGROUP XSDIFY(MATNUM,IGG)=0.0 440 CONTINUE ENDIF IF(LINIXS(12,MATNUM).AND.LOLDXS(12)) THEN LNEWXS(12)=.TRUE. DO 450 IGG=1,NGROUP XSDIFZ(MATNUM,IGG)=0.0 450 CONTINUE ENDIF IF(LINIXS(13,MATNUM).AND.LOLDXS(13)) THEN LNEWXS(13)=.TRUE. DO 462 IGG=1,NGROUP DO 461 IDELG=1,NDELG DO 460 IFS=1,NIFISS XSNUDL(MATNUM,IFS,IDELG,IGG)=0.0 460 CONTINUE 461 CONTINUE 462 CONTINUE ENDIF IF(LINIXS(14,MATNUM).AND.LOLDXS(14)) THEN LNEWXS(14)=.TRUE. DO 472 IGG=1,NGROUP DO 471 IDELG=1,NDELG DO 470 IFS=1,NIFISS XSCHDL(MATNUM,IFS,IDELG,IGG)=0.0 470 CONTINUE 471 CONTINUE 472 CONTINUE ENDIF IF(LINIXS(15,MATNUM).AND.LOLDXS(15)) THEN LNEWXS(15)=.TRUE. DO 480 IGG=1,NGROUP XSOVRV(MATNUM,IGG)=0.0 480 CONTINUE ENDIF IF(LINIXS(16,MATNUM).AND.LOLDXS(16)) THEN LNEWXS(16)=.TRUE. DO 490 IGG=1,NGROUP XSNFTO(MATNUM,IGG)=0.0 490 CONTINUE ENDIF IF(LINIXS(17,MATNUM).AND.LOLDXS(17)) THEN LNEWXS(17)=.TRUE. DO 500 IGG=1,NGROUP XSINT0(MATNUM,IGG)=0.0 500 CONTINUE ENDIF IF(LINIXS(18,MATNUM).AND.LOLDXS(18)) THEN LNEWXS(18)=.TRUE. DO 510 IGG=1,NGROUP XSINT1(MATNUM,IGG)=0.0 510 CONTINUE ENDIF ENDIF *---- * READ MIXTURE INDEX *---- IF(CARLIR.EQ.'MIX') THEN MATNUM=MATNUM+1 ITYPE=0 CALL REDGET(ITYPLU,MATNUM,REALIR,CARLIR,DBLINP) IF(MATNUM.GT.NBMIX) CALL XABORT('MACXSR: MATNUM OVERFLOW.') IF(ITYPLU.NE.1) GO TO 1001 ELSE *---- * ALL MIXTURE READ RETURN *---- IF(IPRINT.GE.1) THEN *---- * FIND MATERIAL FOR WHICH XS ARE READ AND PRINT TYPE OF XS READ *---- WRITE(IUNOUT,6000) NANISO DO 220 IM=1,NBMIX DO 230 IT=1,NCXST IF(.NOT.LINIXS(IT,IM)) THEN CARXST(IT)='READ ' ELSE CARXST(IT)=' ' ENDIF 230 CONTINUE WRITE(IUNOUT,6001) IM,(CARXST(JJ),JJ=1,7),CARXST(15), > CARXST(16),CARXST(17),CARXST(18) 220 CONTINUE ENDIF GO TO 550 ENDIF ENDIF *---- * RETURN TO READ NEXT KEYWORD *---- GO TO 1000 *---- * SCRATCH STORAGE DEALLOCATION *---- 550 DEALLOCATE(LINIXS) RETURN *---- * FORMAT *---- 6000 FORMAT(' CROSS SECTION TYPE',5X,'NTOT0 ',5X,'NUSIGF',5X,'FIXE ', > 5X,'CHI ',5X,'SCAT (NL= 1,',I3,')',8X,'TRANC ',5X,'DIFF ', > 5X,'H-FACTOR',3X,'NFTOT',6X,'FLUX-INTG',2X,'FLUX-INTG-P1') 6001 FORMAT(' MATERIAL ',I5,4X,5(5X,A6),16X,A6,3X,5(5X,A6)) END