*DECK DUO003 SUBROUTINE DUO003(IPLIB,IPRINT,NMIX,NISOT,NGRP,IDIV,ZKEFF,RHS,LHS, > FLUX,AFLUX) * *----------------------------------------------------------------------- * *Purpose: * Processing one of the two microlibs and return isotope-dependent * RHS and LHS matrices. * *Copyright: * Copyright (C) 2013 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 * IPLIB microlib. * IPRINT print parameter. * NMIX number of mixtures. * NISOT number of isotopes. * NGRP number of energy groups. * IDIV type of divergence term processing (=0: no processing; * =1: direct processing; =2: adjoint processing; * =3: direct-adjoint processing). * *Parameters: output * ZKEFF effective multiplication factor. * RHS absorption macroscopic cross-section matrix. * LHS production macroscopic cross-section matrix. * FLUX integrated direct flux. * AFLUX integrated adjoint flux. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPLIB INTEGER IPRINT,NMIX,NISOT,NGRP,IDIV REAL ZKEFF,RHS(NGRP,NGRP,NISOT+NMIX),LHS(NGRP,NGRP,NISOT+NMIX), > FLUX(NGRP,NISOT+NMIX),AFLUX(NGRP,NISOT+NMIX) *---- * LOCAL VARIABLES *---- TYPE(C_PTR) KPLIB CHARACTER HSMG*131 DOUBLE PRECISION SUM *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IHUSED REAL, ALLOCATABLE, DIMENSION(:) :: DENS,VOL,TOTAL,ZNUSF,CHI,SIGS, > DLK,ALK,V,W REAL, ALLOCATABLE, DIMENSION(:,:) :: SCAT TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(IHUSED(3,NISOT),IMIX(NISOT)) ALLOCATE(DENS(NISOT),VOL(NISOT),TOTAL(NGRP),ZNUSF(NGRP), > CHI(NGRP),SCAT(NGRP,NGRP)) ALLOCATE(IPISO(NISOT)) *---- * FIND ISOTOPE POINTERS IN INPUT MICROLIB *---- CALL LIBIPS(IPLIB,NISOT,IPISO) *---- * COMPUTE THE RHS AND LHS MATRICES *---- CALL LCMGET(IPLIB,'ISOTOPESUSED',IHUSED) CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX) CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS) CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL) CALL LCMGET(IPLIB,'K-EFFECTIVE',ZKEFF) IF(IPRINT.GT.1) WRITE(6,'(35H DUO003: EFFECTIVE MULTIPLICATION F, > 6HACTOR=,1P,E12.5)') ZKEFF RHS(:NGRP,:NGRP,:NISOT+NMIX)=0.0 LHS(:NGRP,:NGRP,:NISOT+NMIX)=0.0 DO ISOT=1,NISOT IF(IPRINT.GT.4) WRITE(6,'(29H DUO003: PROCESSING ISOTOPE '', > 3A4,2H''.)') (IHUSED(I0,ISOT),I0=1,3) KPLIB=IPISO(ISOT) ! set ISOT-th isotope IF(.NOT.C_ASSOCIATED(KPLIB)) THEN WRITE(HSMG,'(18H DUO003: ISOTOPE '',3A4,7H'' (ISO=,I8,4H) IS, > 31H NOT AVAILABLE IN THE MICROLIB.)') (IHUSED(I0,ISOT), > I0=1,3),ISOT CALL XABORT(HSMG) ENDIF CALL LCMGET(KPLIB,'NWT0',FLUX(1,ISOT)) CALL LCMLEN(KPLIB,'NWAT0',ILON,ITYLCM) IF(ILON.NE.0) THEN CALL LCMGET(KPLIB,'NWAT0',AFLUX(1,ISOT)) ELSE AFLUX(:NGRP,ISOT)=1.0 ENDIF DO IGR=1,NGRP FLUX(IGR,ISOT)=FLUX(IGR,ISOT)*VOL(ISOT) AFLUX(IGR,ISOT)=AFLUX(IGR,ISOT)*VOL(ISOT) ENDDO CALL LCMGET(KPLIB,'NTOT0',TOTAL) CALL LCMLEN(KPLIB,'NUSIGF',ILON,ITYLCM) IF(ILON.GT.0) THEN CALL LCMGET(KPLIB,'NUSIGF',ZNUSF) CALL LCMGET(KPLIB,'CHI',CHI) DO IGR=1,NGRP DO JGR=1,NGRP LHS(JGR,IGR,ISOT)=LHS(JGR,IGR,ISOT)+DENS(ISOT)*CHI(JGR)* > ZNUSF(IGR) ENDDO ENDDO ENDIF ALLOCATE(SIGS(NGRP)) CALL XDRLGS(KPLIB,-1,IPRINT,0,0,1,NGRP,SIGS,SCAT,ITYPRO) DEALLOCATE(SIGS) DO IGR=1,NGRP DO JGR=1,NGRP RHS(JGR,IGR,ISOT)=RHS(JGR,IGR,ISOT)-DENS(ISOT)*SCAT(JGR,IGR) ENDDO RHS(IGR,IGR,ISOT)=RHS(IGR,IGR,ISOT)+DENS(ISOT)*TOTAL(IGR) ENDDO ENDDO *---- * INTRODUCE THE DIRECT OR ADJOINT DIVERGENCE COMPONENT IN THE RHS * MATRIX *---- DO IBM=1,NMIX IF(IDIV.EQ.1) THEN DO JGR=1,NGRP SUM=0.0D0 FLUMIX=0.0 AFLUMI=0.0 DO ISOT=1,NISOT IF(IMIX(ISOT).EQ.IBM) THEN FLUMIX=FLUX(JGR,ISOT) AFLUMI=AFLUX(JGR,ISOT) DO IGR=1,NGRP SUM=SUM+(RHS(JGR,IGR,ISOT)-LHS(JGR,IGR,ISOT)/ZKEFF)* > FLUX(IGR,ISOT) ENDDO ENDIF ENDDO RHS(JGR,JGR,NISOT+IBM)=-REAL(SUM)/FLUMIX FLUX(JGR,NISOT+IBM)=FLUMIX AFLUX(JGR,NISOT+IBM)=AFLUMI ENDDO ELSE IF(IDIV.EQ.2) THEN DO IGR=1,NGRP SUM=0.0D0 FLUMIX=0.0 AFLUMI=0.0 DO ISOT=1,NISOT IF(IMIX(ISOT).EQ.IBM) THEN FLUMIX=FLUX(IGR,ISOT) AFLUMI=AFLUX(IGR,ISOT) DO JGR=1,NGRP SUM=SUM+(RHS(JGR,IGR,ISOT)-LHS(JGR,IGR,ISOT)/ZKEFF)* > AFLUX(JGR,ISOT) ENDDO ENDIF ENDDO RHS(IGR,IGR,NISOT+IBM)=-REAL(SUM)/AFLUMI FLUX(IGR,NISOT+IBM)=FLUMIX AFLUX(IGR,NISOT+IBM)=AFLUMI ENDDO ELSE IF(IDIV.EQ.3) THEN ALLOCATE(DLK(NGRP),ALK(NGRP)) DO JGR=1,NGRP SUM=0.0D0 FLUMIX=0.0 AFLUMI=0.0 DO ISOT=1,NISOT IF(IMIX(ISOT).EQ.IBM) THEN FLUMIX=FLUX(JGR,ISOT) AFLUMI=AFLUX(JGR,ISOT) DO IGR=1,NGRP SUM=SUM+(RHS(JGR,IGR,ISOT)-LHS(JGR,IGR,ISOT)/ZKEFF)* > FLUX(IGR,ISOT) ENDDO ENDIF ENDDO DLK(JGR)=REAL(SUM) FLUX(JGR,NISOT+IBM)=FLUMIX ENDDO DO IGR=1,NGRP SUM=0.0D0 FLUMIX=0.0 AFLUMI=0.0 DO ISOT=1,NISOT IF(IMIX(ISOT).EQ.IBM) THEN FLUMIX=FLUX(IGR,ISOT) AFLUMI=AFLUX(IGR,ISOT) DO JGR=1,NGRP SUM=SUM+(RHS(JGR,IGR,ISOT)-LHS(JGR,IGR,ISOT)/ZKEFF)* > AFLUX(JGR,ISOT) ENDDO ENDIF ENDDO ALK(IGR)=REAL(SUM) AFLUX(IGR,NISOT+IBM)=AFLUMI ENDDO ALLOCATE(V(NGRP),W(NGRP)) CALL DUO005(NGRP,DLK,ALK,FLUX(1,NISOT+IBM), > AFLUX(1,NISOT+IBM),V,W) DO IGR=1,NGRP DO JGR=1,NGRP RHS(IGR,JGR,NISOT+IBM)=RHS(IGR,JGR,NISOT+IBM)- > V(IGR)-W(JGR) ENDDO ENDDO DEALLOCATE(W,V,ALK,DLK) ENDIF ENDDO *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(SCAT,CHI,ZNUSF,TOTAL,VOL,DENS) DEALLOCATE(IMIX,IHUSED) RETURN END