summaryrefslogtreecommitdiff
path: root/Dragon/src/DUODRV.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/DUODRV.f')
-rw-r--r--Dragon/src/DUODRV.f207
1 files changed, 207 insertions, 0 deletions
diff --git a/Dragon/src/DUODRV.f b/Dragon/src/DUODRV.f
new file mode 100644
index 0000000..6e12abe
--- /dev/null
+++ b/Dragon/src/DUODRV.f
@@ -0,0 +1,207 @@
+*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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 11:34:59 +0000