*DECK DUODRV SUBROUTINE DUODRV(IPLIB1,IPLIB2,IPRINT,LENER,LISOT,LMIXT,LREAC, > NMIX,NISOT,NGRP) * *----------------------------------------------------------------------- * *Purpose: * Compare two microlibs and analyse the discrepancies using the Keff * Clio perturbation formula. * *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 * IPLIB1 first microlib. * IPLIB2 second microlib. * IPRINT print parameter. * LENER energy group analysis flag. * LISOT isotope analysis flag. * LMIXT mixture analysis flag. * LREAC nuclear reaction analysis flag. * NMIX number of mixtures. * NISOT number of isotopes. * NGRP number of energy groups. * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPLIB1,IPLIB2 INTEGER IPRINT,NMIX,NISOT,NGRP LOGICAL LENER,LISOT,LMIXT,LREAC *---- * LOCAL VARIABLES *---- PARAMETER (NSTATE=40) INTEGER ISTATE(NSTATE) DOUBLE PRECISION DBLLIR CHARACTER HREAC*8,CARLIR*12 *---- * ALLOCATABLE ARRAYS *---- REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUX1,AFLUX1,FLUX2,AFLUX2, > FLUXI1,AFLUXI1,FLUXI2,AFLUXI2 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: RHS1,LHS1,RHS2,LHS2,RHSI1, > LHSI1,RHSI2,LHSI2 *---- * SCRATCH STORAGE ALLOCATION * RHS1 absorption macroscopic cross-section matrix * LHS1 production macroscopic cross-section matrix * FLUX1 direct flux * AFLUX1 adjoint flux flux * RHS2 absorption macroscopic cross-section matrix * LHS2 production macroscopic cross-section matrix * FLUX2 direct flux * AFLUX2 adjoint flux flux * RHSI1 absorption macroscopic cross-section matrix * LHSI1 production macroscopic cross-section matrix * FLUXI1 direct flux * AFLUXI1 adjoint flux flux * RHSI2 absorption macroscopic cross-section matrix * LHSI2 production macroscopic cross-section matrix * FLUXI2 direct flux * AFLUXI2 adjoint flux flux *---- ALLOCATE(RHS1(NGRP,NGRP,NMIX),LHS1(NGRP,NGRP,NMIX), > FLUX1(NGRP,NMIX),AFLUX1(NGRP,NMIX),RHS2(NGRP,NGRP,NMIX), > LHS2(NGRP,NGRP,NMIX),FLUX2(NGRP,NMIX),AFLUX2(NGRP,NMIX), > RHSI1(NGRP,NGRP,NISOT+NMIX),LHSI1(NGRP,NGRP,NISOT+NMIX), > FLUXI1(NGRP,NISOT+NMIX),AFLUXI1(NGRP,NISOT+NMIX), > RHSI2(NGRP,NGRP,NISOT+NMIX),LHSI2(NGRP,NGRP,NISOT+NMIX), > FLUXI2(NGRP,NISOT+NMIX),AFLUXI2(NGRP,NISOT+NMIX)) *---- * -- MIXTURE KEYWORD -- * CONSTRUCT THE RHS AND LHS MATRICES FOR THE FIRST SYSTEM *---- IF(.NOT.LMIXT) GO TO 100 IF(IPRINT.GT.1) THEN WRITE(6,'(/48H DUODRV: ANALYSIS OF THE FIRST SYSTEM -- MIXTURE, > 8H KEYWORD)') ENDIF CALL LCMSIX(IPLIB1,'MACROLIB',1) CALL LCMGET(IPLIB1,'STATE-VECTOR',ISTATE) NFIS=ISTATE(4) CALL DUO001(IPLIB1,IPRINT,NMIX,NGRP,NFIS,3,ZKEFF1,RHS1,LHS1,FLUX1, > AFLUX1) CALL LCMSIX(IPLIB1,' ',2) *---- * CONSTRUCT THE RHS AND LHS MATRICES FOR THE SECOND SYSTEM *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/48H DUODRV: ANALYSIS OF THE SECOND SYSTEM -- MIXTUR, > 9HE KEYWORD)') ENDIF CALL LCMSIX(IPLIB2,'MACROLIB',1) CALL LCMGET(IPLIB2,'STATE-VECTOR',ISTATE) NFIS=ISTATE(4) CALL DUO001(IPLIB2,IPRINT,NMIX,NGRP,NFIS,3,ZKEFF2,RHS2,LHS2,FLUX2, > AFLUX2) CALL LCMSIX(IPLIB2,' ',2) *---- * PRINT THE DETAILED DELTA-RHO USING THE CLIO FORMULA *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/33H DUODRV: PERFORMING CLIO ANALYSIS)') ENDIF CALL DUO002(IPRINT,NMIX,NGRP,LENER,ZKEFF1,ZKEFF2,RHS1,RHS2, > LHS1,LHS2,FLUX2,AFLUX1) *---- * -- ISOTOPE KEYWORD -- * CONSTRUCT THE RHS AND LHS MATRICES FOR THE FIRST SYSTEM *---- 100 IF(.NOT.LISOT) GO TO 200 IF(IPRINT.GT.1) THEN WRITE(6,'(/48H DUODRV: ANALYSIS OF THE FIRST SYSTEM -- ISOTOPE, > 8H KEYWORD)') ENDIF CALL DUO003(IPLIB1,IPRINT,NMIX,NISOT,NGRP,3,ZKEFF1,RHSI1, > LHSI1,FLUXI1,AFLUXI1) *---- * CONSTRUCT THE RHS AND LHS MATRICES FOR THE SECOND SYSTEM *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/48H DUODRV: ANALYSIS OF THE SECOND SYSTEM -- ISOTOP, > 9HE KEYWORD)') ENDIF CALL DUO003(IPLIB2,IPRINT,NMIX,NISOT,NGRP,3,ZKEFF2,RHSI2, > LHSI2,FLUXI2,AFLUXI2) *---- * PRINT THE DETAILED DELTA-RHO USING THE CLIO FORMULA *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/33H DUODRV: PERFORMING CLIO ANALYSIS)') ENDIF CALL DUO004(IPLIB1,IPRINT,NMIX,NISOT,NGRP,LENER,ZKEFF1,ZKEFF2, > RHSI1,RHSI2,LHSI1,LHSI2,FLUXI2,AFLUXI1) *---- * -- REAC KEYWORD -- *---- 200 IF(.NOT.LREAC) GO TO 230 CALL DUO003(IPLIB2,0,NMIX,NISOT,NGRP,3,ZKEFF2,RHSI2,LHSI2, > FLUXI2,AFLUXI2) * 210 CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR) IF(ITYPLU.NE.3) CALL XABORT('DUODRV: READ ERROR - CHARACTER VA' > //'RIABLE EXPECTED') 220 IF(CARLIR.EQ.'ENDREAC') THEN CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR) IF(ITYPLU.NE.3) CALL XABORT('DUODRV: READ ERROR - CHARACTER ' > //'VARIABLE EXPECTED') IF(CARLIR.NE.';') CALL XABORT('DUODRV: ; KEYWORD EXPECTED') GO TO 230 ENDIF HREAC=CARLIR(:8) *---- * CONSTRUCT THE RHS MATRIX FOR THE FIRST SYSTEM *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/49H DUODRV: ANALYSIS OF THE FIRST SYSTEM -- REACTION, > 1X,A8,1H.)') HREAC ENDIF CALL DUO006(IPLIB1,IPRINT,NISOT,NGRP,HREAC,3,RHSI1,FLUXI1,AFLUXI1) *---- * CONSTRUCT THE RHS MATRIX FOR THE SECOND SYSTEM *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/48H DUODRV: ANALYSIS OF THE SECOND SYSTEM -- REACTI, > 2HON,1X,A8,1H.)') HREAC ENDIF CALL DUO006(IPLIB2,IPRINT,NISOT,NGRP,HREAC,3,RHSI2,FLUXI2,AFLUXI2) *---- * PRINT THE DETAILED DELTA-RHO USING THE CLIO FORMULA *---- IF(IPRINT.GT.1) THEN WRITE(6,'(/47H DUODRV: PERFORMING CLIO ANALYSIS FOR REACTION , > A8,1H.)') HREAC ENDIF CALL DUO007(IPLIB1,IPRINT,NISOT,NGRP,LENER,RHSI1,RHSI2,LHSI2, > FLUXI2,AFLUXI1,RHOREA) * CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR) IF(ITYPLU.NE.3) CALL XABORT('DUODRV: READ ERROR - CHARACTER VA' > //'RIABLE EXPECTED') IF(CARLIR.EQ.'PICK') THEN CALL REDGET(ITYPLU,INTLIR,RHOREA,CARLIR,DBLLIR) IF(ITYPLU.NE.-2) CALL XABORT('DUODRV: OUTPUT REAL EXPECTED') ITYPLU=2 CALL REDPUT(ITYPLU,INTLIR,RHOREA,CARLIR,DBLLIR) ELSE GO TO 220 ENDIF GO TO 210 *---- * SCRATCH STORAGE DEALLOCATION *---- 230 DEALLOCATE(AFLUXI2,FLUXI2,LHSI2,RHSI2,AFLUXI1,FLUXI1,LHSI1,RHSI1, > AFLUX2,FLUX2,LHS2,RHS2,AFLUX1,FLUX1,LHS1,RHS1) RETURN END