1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
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
|
