diff options
Diffstat (limited to 'Dragon/src/DUO002.f')
| -rw-r--r-- | Dragon/src/DUO002.f | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/Dragon/src/DUO002.f b/Dragon/src/DUO002.f new file mode 100644 index 0000000..91e6a97 --- /dev/null +++ b/Dragon/src/DUO002.f @@ -0,0 +1,158 @@ +*DECK DUO002 + SUBROUTINE DUO002(IPRINT,NMIX,NGRP,LENER,ZKEFF1,ZKEFF2,RHS1,RHS2, + > LHS1,LHS2,FLUX2,AFLUX1) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Print the detail of mixture delta-rho discrepancies between two +* calculations +* +*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 +* IPRINT print parameter. +* NMIX number of mixtures. +* NGRP number of energy groups. +* LENER energy group analysis flag. +* ZKEFF1 effective multiplication factor of the first calculation. +* ZKEFF2 effective multiplication factor of the second calculation. +* RHS1 absorption macroscopic cross-section matrix for the first +* calculation. +* RHS2 absorption macroscopic cross-section matrix for the second +* calculation. +* LHS1 production macroscopic cross-section matrix for the first +* calculation. +* LHS2 production macroscopic cross-section matrix for the second +* calculation. +* FLUX2 flux for the second calculation. +* AFLUX1 adjoint flux for the first calculation. +* +*----------------------------------------------------------------------- +* +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER IPRINT,NMIX,NGRP + LOGICAL LENER + REAL ZKEFF1,ZKEFF2,RHS1(NGRP,NGRP,NMIX),RHS2(NGRP,NGRP,NMIX), + > LHS1(NGRP,NGRP,NMIX),LHS2(NGRP,NGRP,NMIX),FLUX2(NGRP,NMIX), + > AFLUX1(NGRP,NMIX) +*---- +* LOCAL VARIABLES +*---- + DOUBLE PRECISION ZNUM,ZDEN,RHO12 + CHARACTER TEXT12*12 +*---- +* ALLOCATABLE ARRAYS +*---- + REAL, ALLOCATABLE, DIMENSION(:) :: RHO1,RHO2 + REAL, ALLOCATABLE, DIMENSION(:,:) :: RHO +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(RHO(NGRP,NMIX),RHO1(NGRP),RHO2(NMIX)) +*---- +* RAYLEIGH RATIO FOR THE FIRST SYSTEM +*---- + IF(IPRINT.GT.1) THEN + ZNUM=0.0D0 + ZDEN=0.0D0 + DO IBM=1,NMIX + DO IGR=1,NGRP + DO JGR=1,NGRP + ZNUM=ZNUM+LHS1(JGR,IGR,IBM)*AFLUX1(JGR,IBM)*FLUX2(IGR,IBM) + ZDEN=ZDEN+RHS1(JGR,IGR,IBM)*AFLUX1(JGR,IBM)*FLUX2(IGR,IBM) + ENDDO + ENDDO + ENDDO + WRITE(6,100) 1,ZNUM/ZDEN,ZKEFF1 + ENDIF +*---- +* RAYLEIGH RATIO FOR THE SECOND SYSTEM +*---- + IF(IPRINT.GT.1) THEN + ZNUM=0.0D0 + ZDEN=0.0D0 + DO IBM=1,NMIX + DO IGR=1,NGRP + DO JGR=1,NGRP + ZNUM=ZNUM+LHS2(JGR,IGR,IBM)*AFLUX1(JGR,IBM)*FLUX2(IGR,IBM) + ZDEN=ZDEN+RHS2(JGR,IGR,IBM)*AFLUX1(JGR,IBM)*FLUX2(IGR,IBM) + ENDDO + ENDDO + ENDDO + WRITE(6,100) 2,ZNUM/ZDEN,ZKEFF2 + ENDIF +*---- +* PERTURBATIVE ANALYSIS WITH THE CLIO FORMULA +*---- + RHO(:NGRP,:NMIX)=0.0 + RHO1(:NGRP)=0.0 + RHO2(:NMIX)=0.0 + ZDEN=0.0D0 + DO IBM=1,NMIX + DO IGR=1,NGRP + DO JGR=1,NGRP + DRHS=(RHS2(JGR,IGR,IBM)-RHS1(JGR,IGR,IBM)) + DLHS=(LHS2(JGR,IGR,IBM)-LHS1(JGR,IGR,IBM)) + RHO(IGR,IBM)=RHO(IGR,IBM)+(DRHS-DLHS/ZKEFF1)* + > AFLUX1(JGR,IBM)*FLUX2(IGR,IBM) + ZDEN=ZDEN+LHS2(JGR,IGR,IBM)*AFLUX1(JGR,IBM)* + > FLUX2(IGR,IBM) + ENDDO + ENDDO + ENDDO + RHO12=0.0D0 + DO IBM=1,NMIX + DO IGR=1,NGRP + RHO(IGR,IBM)=RHO(IGR,IBM)*1.0E5/REAL(ZDEN) + RHO1(IGR)=RHO1(IGR)+RHO(IGR,IBM) + RHO2(IBM)=RHO2(IBM)+RHO(IGR,IBM) + RHO12=RHO12+RHO(IGR,IBM) + ENDDO + ENDDO + DELLAM=((1./ZKEFF2)-(1./ZKEFF1))*1.0E5 + DELTA=ABS(DELLAM-REAL(RHO12)) + IF(DELTA.GT.2.0) CALL XABORT('DUO002: FAILURE OF DUO: MODULE TO ' + > //'ANALYSE THE DELTA-RHO DISCREPANCY WITHIN 2 PCM.') +*---- +* PRINT DELTA-RHO +*---- + IF(LENER) THEN + WRITE(6,'(/47H DUO002: DELTA-RHO MIXTURE-MULTIGROUP DISCREPAN, + > 12HCIES IN PCM:)') + WRITE(6,'(14X,9I12)') (IGR,IGR=1,NGRP) + IF(IPRINT.GT.0) THEN + DO IBM=1,NMIX + WRITE(TEXT12,'(4HMIXT,I6.6)') IBM + WRITE(6,110) TEXT12,(RHO(IGR,IBM),IGR=1,NGRP) + ENDDO + ENDIF + WRITE(6,120) (RHO1(IGR),IGR=1,NGRP) + ENDIF + WRITE(6,'(/48H DUO002: DELTA-RHO MIXTURE-DISCREPANCIES IN PCM:)') + DO IBM=1,NMIX + WRITE(TEXT12,'(4HMIXT,I6.6)') IBM + WRITE(6,110) TEXT12,RHO2(IBM) + ENDDO + WRITE(6,120) RHO12 + WRITE(6,'(14H *** SUM *** ,F12.2,8H (EXACT))') DELLAM +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(RHO2,RHO1,RHO) + RETURN +* + 100 FORMAT(16H DUO002: SYSTEM=,I2,21H DIRECT-ADJOINT KEFF=,1P,E13.5, + > 13H EXACT VALUE=,E13.5) + 110 FORMAT(1X,A12,1X,9F12.2/(14X,9F12.2)) + 120 FORMAT(/14H *** SUM *** ,9F12.2/(14X,9F12.2)) + END |