diff options
Diffstat (limited to 'Dragon/src/MACXSR.f')
| -rw-r--r-- | Dragon/src/MACXSR.f | 690 |
1 files changed, 690 insertions, 0 deletions
diff --git a/Dragon/src/MACXSR.f b/Dragon/src/MACXSR.f new file mode 100644 index 0000000..2824ee2 --- /dev/null +++ b/Dragon/src/MACXSR.f @@ -0,0 +1,690 @@ +*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 |