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
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
*DECK SENDRV
SUBROUTINE SENDRV(IPSENS,IPTRACK,IPLIB,IPFLUX,IPAFLUX,IPRINT,
> NR,NU,NI,NG,NANIS,NLTERM)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Creation of sensitivity profiles to
* cross-section on the reactivity using first order perturbation
* method using the adjoint calculation.
*
*Copyright:
* Copyright (C) 2011 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): C. Laville, G. Marleau
*
*Parameters: input/output
* IPSENS LCM Sensitivity object address.
* IPTRACK LCM Tracking object address.
* IPLIB LCM Library object address.
* IPFLUX LCM Flux object address.
* IPAFLUX LCM Adjoin flux object address.
* IPRINT print level.
* NR number of region in Tracking object.
* NU number of unkwnow in Tracking/Flux objects.
* NI number of isotopes in Library object.
* NG number of energy group in Library object.
* NANIS anisotropy order kept.
* NLTERM total number of term of the flux.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* Suboutine arguements
*----
TYPE(C_PTR) IPTRACK,IPLIB,IPFLUX,IPAFLUX
INTEGER IPSENS,NR,NU,NI,NG,IPRINT,NANIS,NLTERM
*----
* Local variables
*----
TYPE(C_PTR) KPISO,JPFLUX,JPAFLUX
INTEGER IG,JG,IR,KL,KKEYL,IL,IM,II
INTEGER ILENG,ILON,ITYLCM,NSENI,NSENS,NIC
REAL KEFF,D
CHARACTER ISONAM*12,REV*48,DATE*64,HSMG*131
*----
* Allocatable arrays
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: MAT,KEY,MELISO,ISOC
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMISO,NAMISC
REAL, ALLOCATABLE, DIMENSION(:) :: VOL,ENERG,DENISO,SOLFLU,NUSIGF,
> CHI
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLUXI,AFLUX
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: P
TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO
*----
* Parameters
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='SENDRV')
*----
* Scratch storage allocation
* MAT Mixture of each region in Tracking object.
* KEY Localisation of the flux/aflux for each region in Tracking
* object.
* MELISO Mixture of each isotope/region in Library object.
* NAMISO Alias of each isotope/region in Library object.
* NAMISC Independent isotopes names.
* ISOC Independent isotope number associated with isotope/mixture.
* VOL Volume of each region in Tracking object.
* ENERG Energy boundaries in Library object.
* DENISO Density of each isotope/region in Library object.
* SOLFLU Flux solution of each region in Flux object.
* FLUXI Flux of each region multiplied by the volume of the region.
* AFLUX Adjoint flux of each region.
* P Matrix calcution for sensitivity analysis.
* NUSIGF Vector for nubar multiplied by the fission cross-section
* CHI Vector for fission spectra.
*----
ALLOCATE(MAT(NR),KEY(NU),MELISO(NI),NAMISO(3,NI),NAMISC(2,NI),
> ISOC(NI))
ALLOCATE(VOL(NR),ENERG(NG+1),DENISO(NI),SOLFLU(NU),
> FLUXI(NR,NLTERM,NG),AFLUX(NR,NLTERM,NG),P(NR,NANIS,NG,NG),
> NUSIGF(NG),CHI(NG))
*--------
* Step 1:
* Recover Tracking informations
* a) VOLUME
* b) MATCOL
* c) KEYFLX
*----
VOL(:NR)=0.0
CALL LCMGET(IPTRACK,'VOLUME',VOL)
*----
MAT(:NR)=0
CALL LCMGET(IPTRACK,'MATCOD',MAT)
*----
KEY(:NU)=0
CALL LCMGET(IPTRACK,'KEYFLX',KEY)
*----
* Print information if required
*----
IF(IPRINT .GE. 5) THEN
WRITE(IOUT,'(3(A12,8X))') 'Region # ','VOLUMES ',
> 'MATCOD '
WRITE(IOUT,'(I10,10X,E16.7,4X,I8)')
> (IR,VOL(IR),MAT(IR),IR=1,NR)
ENDIF
*--------
* Step 2:
* Recover library informations
* a) ENERGY GROUP BOUNDARIES
* b) MIXTURE ASSOCIATED WITH ISOTOPE
* c) ISOTOPES ALIAS
* d) ISOTOPES DENSITIES
*----
ENERG(:NG+1)=0.0
CALL LCMGET(IPLIB,'ENERGY',ENERG)
*----
MELISO(:NI)=0
CALL LCMGET(IPLIB,'ISOTOPESMIX',MELISO)
*----
CALL LCMGET(IPLIB,'ISOTOPESUSED',NAMISO)
*----
DENISO(:NI)=0.0
CALL LCMGET(IPLIB,'ISOTOPESDENS',DENISO)
*----
* Scan library to determine number of sensitivity profiles:
* NIC is number of independent isotopes
* ISOC is the independent isotope number associated with
* each isotope/mixture
* NAMISC is the independent isotope name
*----
CALL SENCNT(IPLIB,NI,NAMISO,MELISO,
> NSENS,NSENI,NAMISC,ISOC,NIC)
IF(IPRINT.GE.1) THEN
WRITE(IOUT,6000) NSENS+NSENI,NSENI
ENDIF
*----
* Print information if required
*----
IF(IPRINT .GE. 5) THEN
WRITE(IOUT,'(A12)') 'ENERGY '
WRITE(IOUT,'(5E14.6)') (ENERG(IG),IG=1,NG+1)
WRITE(IOUT,'(6(A12,8X))') 'Isotope # ','ISOTOPESMIX ',
> 'ISOTOPESUSED','ISOTOPESDENS',
> 'Name Int Sen','IsoComb '
WRITE(IOUT,'(I8,12X,I8,12X,3A4,8X,E16.7,4X,2A4,12X,I8)')
> (II,MELISO(II),NAMISO(1,II),NAMISO(2,II),NAMISO(3,II),
> DENISO(II),NAMISC(1,ABS(ISOC(II))),NAMISC(2,ABS(ISOC(II))),
> ISOC(II),II=1,NI)
ENDIF
*--------
* Step 3:
* Recover K-effective, flux and adjoint,
* and compute integrated flux.
*----
KEFF=0
CALL LCMGET(IPFLUX,'K-EFFECTIVE',KEFF)
*----
FLUXI(:NR,:NLTERM,:NG)=0.0
AFLUX(:NR,:NLTERM,:NG)=0.0
CALL LCMLEN(IPFLUX,'FLUX',ILON,ITYLCM)
IF(ILON.EQ.0) CALL XABORT(NAMSBR//': MISSING FLUX INFO.')
JPFLUX=LCMGID(IPFLUX,'FLUX')
DO IG=1,NG
CALL LCMGDL(JPFLUX,IG,SOLFLU)
KL=0
KKEYL=0
DO IL=1,NANIS
DO IM=1,IL ! 2*IL-1 in 3D
KL=KL+1
DO IR=1,NR
FLUXI(IR,KL,IG)=SOLFLU(KEY(IR+KKEYL))*VOL(IR)
ENDDO
KKEYL=KKEYL+NR
ENDDO
ENDDO
ENDDO
CALL LCMLEN(IPAFLUX,'AFLUX',ILON,ITYLCM)
IF(ILON.EQ.0) CALL XABORT(NAMSBR//': MISSING AFLUX INFO.')
JPAFLUX=LCMGID(IPAFLUX,'AFLUX')
DO IG=1,NG
CALL LCMGDL(JPAFLUX,IG,SOLFLU)
KL=0
KKEYL=0
DO IL=1,NANIS
DO IM=1,IL ! 2*IL-1 in 3D
KL=KL+1
DO IR=1,NR
AFLUX(IR,KL,IG)=SOLFLU(KEY(IR+KKEYL))
ENDDO
KKEYL=KKEYL+NR
ENDDO
ENDDO
ENDDO
*--------
* Step 4:
* Computation of the P matrix used for sensitivity calculation
*----
P(:NR,:NANIS,:NG,:NG)=0.0
DO IG=1,NG
DO JG=1,NG
KL=0
DO IL=1,NANIS
DO IM=1,IL ! 2*IL-1 en 3D
KL=KL+1
DO IR=1,NR
P(IR,IL,IG,JG)=P(IR,IL,IG,JG)+
> FLUXI(IR,KL,IG)*AFLUX(IR,KL,JG)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
*--------
* Step 5:
* Computation of the D factor
*----
D=0
ALLOCATE(IPISO(NI))
CALL LIBIPS(IPLIB,NI,IPISO)
DO II=1,NI
KPISO=IPISO(II) ! set II-th isotope
IF(.NOT.C_ASSOCIATED(KPISO)) THEN
WRITE(ISONAM,'(3A4)') NAMISO(1,II),NAMISO(2,II),NAMISO(3,II)
WRITE(HSMG,'(17HSENDRV: ISOTOPE '',A12,7H'' (ISO=,I8,5H) IS ,
1 30HNOT AVAILABLE IN THE MICROLIB.)') ISONAM,II
CALL XABORT(HSMG)
ENDIF
CALL LCMLEN(KPISO,'NUSIGF',ILENG,ITYLCM)
IF(ILENG.GT.0) THEN
NUSIGF(:NG)=0.0
CHI(:NG)=0.0
CALL LCMGET(KPISO,'NUSIGF',NUSIGF)
CALL LCMGET(KPISO,'CHI',CHI)
DO IR=1,NR
IF(MAT(IR).EQ.MELISO(II)) THEN
DO IG=1,NG
DO JG=1,NG
D=D+FLUXI(IR,1,IG)*DENISO(II)
> *NUSIGF(IG)*CHI(JG)*AFLUX(IR,1,JG)
ENDDO
ENDDO
ENDIF
ENDDO
ENDIF
ENDDO
DEALLOCATE(IPISO)
*--------
* Step 6:
* Initialize the top of the .sdf file
*----
WRITE(IPSENS,7000) NG,NSENS+NSENI,NSENI,KEFF
WRITE(IPSENS,7001)
WRITE(IPSENS,7002) (ENERG(IG),IG=1,NG+1)
*--------
* Step 7:
* Sensitivity analysis for each isotope/mixture
*----
CALL SENCAL(IPSENS,IPLIB,IPRINT,NR,NG,NI,NANIS,NAMISO,MELISO,
> MAT,DENISO,KEFF,P,D,NAMISC,ISOC,NIC)
*--------
* Step 9:
* Finish the creation of the .sdf file
*----
CALL KDRVER(REV,DATE)
WRITE(IPSENS,7010) REV,DATE
*----
* Scratch storage deallocation
*----
DEALLOCATE(CHI,NUSIGF,P,AFLUX,FLUXI,SOLFLU,DENISO,ENERG,VOL)
DEALLOCATE(ISOC,NAMISC,NAMISO,MELISO,KEY,MAT)
RETURN
*----
* Formats
*----
6000 FORMAT('Total number of profils (reactions,isotopes,mixtures) :',
>5X,I10/'Total number of integrated profiles ',
>'(reactions,isotopes) :',3X,I10)
7000 FORMAT(
>I10,3X,'number of neutron groups'/
>I10,3X,'number of sensitivity profiles ',
>I10,3X,'are region integrated'/
>F10.6,3X,'k-eff from the forward case')
7001 FORMAT('energy boundaries:')
7002 FORMAT(1P,5E14.6)
7010 FORMAT(//1X,'file verification information'/
>1X,'code system: DRAGON'/
>1X,'Version: ',A48/
>1X,'program: SENS:'/
>3X,'creation date: ',A64/
>3X,'library: UNKWNOW'/
>3X,'this is not a scale configuration controlled code')
END
|
