*DECK MACNXS SUBROUTINE MACNXS(IPLIST,MAXFIS,NGROUP,NBMIX,NIFISS,NANISO) * *----------------------------------------------------------------------- * *Purpose: * Normalization of macroscopic cross section information. * *Copyright: * Copyright (C) 2002 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 * IPLIST LCM pointer to the macrolib. * MAXFIS set to max(1,NIFISS). * NGROUP number of energy groups. * NBMIX number of mixtures. * NIFISS number of fissile isotopes. * NANISO maximum Legendre order: * =1 isotropic collision; * =2 linearly anisotropic collision. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPLIST INTEGER MAXFIS,NGROUP,NBMIX,NIFISS,NANISO *---- * LOCAL VARIABLES *---- TYPE(C_PTR) JPLIST,KPLIST CHARACTER CANISO*2 *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: INGSCT,IFGSCT REAL, ALLOCATABLE, DIMENSION(:) :: XSWORK,XSWOR2 REAL, ALLOCATABLE, DIMENSION(:,:) :: CHWORK DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: SCWORK *---- * SCRATCH STORAGE ALLOCATION * INGSCT number of scattering group for cross sections. * IFGSCT first scattering group for cross sections. *---- ALLOCATE(INGSCT(NBMIX),IFGSCT(NBMIX)) ALLOCATE(XSWORK(NBMIX*NGROUP),XSWOR2(NBMIX*NIFISS), > CHWORK(NBMIX,MAXFIS)) ALLOCATE(SCWORK(NBMIX,NANISO,NGROUP)) * DO 100 IMIX=1,NBMIX DO 110 IAN=1,NANISO DO 120 IG=1,NGROUP SCWORK(IMIX,IAN,IG)=0.0D0 120 CONTINUE 110 CONTINUE DO 130 JFIS=1,NIFISS CHWORK(IMIX,JFIS)=0.0 130 CONTINUE 100 CONTINUE JPLIST=LCMGID(IPLIST,'GROUP') DO 140 IGR=1,NGROUP KPLIST=LCMGIL(JPLIST,IGR) *---- * COMPUTE SUM OF FISSION SPECTRUM. *---- CALL LCMLEN(KPLIST,'CHI',ILCMLN,ITYLCM) IF(ILCMLN.GT.0) THEN CALL LCMGET(KPLIST,'CHI',XSWOR2) DO 150 IFISS=1,NIFISS DO 160 IMAT=1,NBMIX CHWORK(IMAT,IFISS)=CHWORK(IMAT,IFISS) > +XSWOR2((IFISS-1)*NBMIX+IMAT) 160 CONTINUE 150 CONTINUE ENDIF *---- * SUM TRANSFER MATRICES OVER SECONDARY GROUPS. *---- DO 170 IANIS=1,NANISO WRITE(CANISO,'(I2.2)') IANIS-1 CALL LCMLEN(KPLIST,'NJJS'//CANISO,ILCMLN,ITYLCM) IF(ILCMLN.GT.0) THEN CALL LCMGET(KPLIST,'NJJS'//CANISO,INGSCT) CALL LCMGET(KPLIST,'IJJS'//CANISO,IFGSCT) CALL LCMGET(KPLIST,'SCAT'//CANISO,XSWORK) IPO=0 DO 180 IMAT=1,NBMIX IDG=IFGSCT(IMAT) IFG=IDG-INGSCT(IMAT)+1 DO 190 JGR=IDG,IFG,-1 IPO=IPO+1 SCWORK(IMAT,IANIS,JGR)=SCWORK(IMAT,IANIS,JGR) > +XSWORK(IPO) 190 CONTINUE 180 CONTINUE ENDIF 170 CONTINUE 140 CONTINUE *---- * WRITE NORMALIZED X-S ON THE MACROLIB. *---- DO 200 IGR=1,NGROUP KPLIST=LCMGIL(JPLIST,IGR) CALL LCMLEN(KPLIST,'CHI',ILCMLN,ITYLCM) IF(ILCMLN.GT.0) THEN CALL LCMGET(KPLIST,'CHI',XSWOR2) DO 210 IFISS=1,NIFISS DO 220 IMAT=1,NBMIX IF(CHWORK(IMAT,IFISS).GT.0.5) XSWOR2((IFISS-1)*NBMIX+IMAT) > =XSWOR2((IFISS-1)*NBMIX+IMAT)/CHWORK(IMAT,IFISS) 220 CONTINUE 210 CONTINUE CALL LCMPUT(KPLIST,'CHI',NBMIX*NIFISS,2,XSWOR2) ENDIF DO 230 IANIS=1,NANISO WRITE(CANISO,'(I2.2)') IANIS-1 CALL LCMLEN(KPLIST,'SIGS'//CANISO,ILCMLN,ITYLCM) IF(ILCMLN.GT.0) THEN DO 240 IMAT=1,NBMIX XSWORK(IMAT)=REAL(SCWORK(IMAT,IANIS,IGR)) 240 CONTINUE CALL LCMPUT(KPLIST,'SIGS'//CANISO,NBMIX,2,XSWORK) ENDIF 230 CONTINUE 200 CONTINUE *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(SCWORK) DEALLOCATE(CHWORK,XSWOR2,XSWORK) DEALLOCATE(IFGSCT,INGSCT) RETURN END