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
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
*DECK CPODRV
SUBROUTINE CPODRV(IPCPO ,IPEDIT,IPDEPL,IPRINT,CURNAM,CTITRE,
> NAMCPO,NGROUP,NMERGE,NBMICR,NIFISS,MXBURN,
> NL ,NISCPO,NPROC ,ILEAKS,NXXXZ ,NEDMAC,
> HVECT ,NSBS ,ILOCAL,ISOCPO,ISOTMP,IDIMIX,
> NBIMRG,ICOMIX,VOLMER,ENERGY,TIME ,BURN ,
> WIRRAD,IBSTEP)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover cross section information located on directory CURNAM or on
* directory family with prefix CURNAM.
*
*Copyright:
* Copyright (C) 2007 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): G. Marleau
*
*Parameters: input
* IPCPO pointer to the compo (L_COMPO signature).
* IPEDIT pointer to edit information (L_EDIT signature).
* IPDEPL pointer to depletion information (L_BURNUP signature).
* IPRINT print parameter. Equal to zero for no print.
* CURNAM name of the output directory (or prefix of output
* directory in burnup cases).
* CTITRE character*72 title.
* NAMCPO character*8 name of the material mixture sub-directory.
* NGROUP number of energy groups in output data.
* NMERGE number of output regions.
* NBMICR maximum number of isotopes.
* NIFISS number of fissile isotopes.
* MXBURN maximum number of output burnup sets.
* NL number of Legendre orders (=1 for isotropic scattering).
* NISCPO number of Compo isotopes treated.
* NPROC number of microscopic xs to process.
* ILEAKS leak option: 0 no leakage ; 1 homogeneous leakage ;
* 2 heterogeneous leakage.
* NXXXZ maximum dimension of ISO dependent vector = max(nbmicr,1).
* NEDMAC number of edit xs.
* HVECT name of edit xs.
* NSBS number of sub-burnup step considered.
* ILOCAL local parameter flag (0: global; 1:local).
* ISOCPO Compo name of isotopes.
* ISOTMP name of isotopes in EDIT.
* IDIMIX isotopes identifier in each Compo material.
* NBIMRG final number of isotope per region.
* ICOMIX pointer to Compo isotope for region.
* VOLMER merge volume.
* ENERGY energy.
* TIME time steps.
* BURN burnup.
* WIRRAD irradiation.
* IBSTEP sub-burnup step considered.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPCPO,IPEDIT,IPDEPL
INTEGER IPRINT,NGROUP,NMERGE,CTITRE(18),NBMICR,NIFISS,
> MXBURN,NL,NISCPO,NPROC ,ILEAKS,NXXXZ,NEDMAC,
> NSBS ,ILOCAL,ISOCPO(3,NXXXZ),ISOTMP(3,NXXXZ),
> IDIMIX(NMERGE,NXXXZ),NBIMRG(NMERGE),
> ICOMIX(NMERGE,NXXXZ),IBSTEP(MXBURN)
CHARACTER CURNAM*12,NAMCPO*8,HVECT(NEDMAC)*8
REAL VOLMER(NMERGE),ENERGY(NGROUP+1),
> TIME(MXBURN),BURN(MXBURN),WIRRAD(MXBURN)
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: INDPRO,ITYPRO,NAMI
REAL, ALLOCATABLE, DIMENSION(:) :: DENTMP,EMJMAC,VECT,XSREC,XSCAT,
1 DISFC,DENSI,EMJI
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: RVALOC
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: DENCPO,XSREM,SCREM
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DXSMIC,DMJCPO
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: DSCMIC,DXSMAC,
1 DISFAC
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:,:) :: DSCMAC
*----
* LOCAL PARAMETERS
*----
INTEGER IOUT,NSTATE,NDPROC,NPARAM
REAL CUTOFF
PARAMETER (IOUT=6,NSTATE=40,NDPROC=20,NPARAM=4,
> CUTOFF=1.0E5)
INTEGER NEFBRN,IBR,IBR2,IBURN,NDUM1,NDUM2,MAXDM,
> IMRG,ISOC,ISOR,ITC,IDFLU,
> ISTATE(NSTATE),IPARAM(NPARAM),MXISOS,
> NBISO,NREAC,NVAR,NBMIX,NREG,NLOC
CHARACTER NAMMIX*12,NAMBRN*12,NAMISO*12,NAMMAC*12
REAL DELTA(2),TMPDAY(3),DELERR(3)
DOUBLE PRECISION DMJMAC
INTEGER IFCDIS
*----
* SCRATCH STORAGE ALLOCATION
* DENTMP density of EDI isotopes.
* EMJMAC fission energy for macroscopic data.
* DENCPO density of Compo isotopes.
* DMJCPO fission energy for macroscopic data.
* INDPRO identifier for xs processing.
* ITYPRO identifier for xs processed.
* DXSMIC micro vector xs.
* DSCMIC micro scattering matrix xs.
* DXSMAC macro vector xs.
* DSCMAC macro scattering matrix xs.
* DISFAC discontinuity factors.
* RVALOC local burnup and irradiation values.
*----
ALLOCATE(INDPRO(NPROC),ITYPRO(NPROC))
ALLOCATE(DENTMP(NXXXZ),EMJMAC(NMERGE),RVALOC(2,NMERGE,MXBURN))
ALLOCATE(DENCPO(NXXXZ),DXSMIC(NGROUP,NPROC),
> DSCMIC(NGROUP,NGROUP,NL),DXSMAC(NGROUP,NPROC,NMERGE),
> DSCMAC(NGROUP,NGROUP,NL,NMERGE),DMJCPO(2,NXXXZ),
> DISFAC(2,NGROUP,3))
*----
* GET GLOBAL BURNUP AND IRRADIATION
*----
IFCDIS=1
NAMMAC='MACR '
IF(NSBS.EQ.0) THEN
BURN(1)=0.0
WIRRAD(1)=0.0
NEFBRN=1
IBSTEP(NEFBRN)=0
ELSE
DO 100 IBR=1,NSBS
IBURN=IBSTEP(IBR)
IF(IBURN.GT.0.AND. IBURN.LE.MXBURN) THEN
WRITE(NAMBRN,'(8HDEPL-DAT,I4.4)') IBURN
CALL LCMSIX(IPDEPL,NAMBRN,1)
CALL LCMGET(IPDEPL,'BURNUP-IRRAD',DELTA)
BURN(IBR)=DELTA(1)
WIRRAD(IBR)=DELTA(2)
TIME(IBR)=TIME(IBURN)
CALL LCMSIX(IPDEPL,NAMBRN,2)
ENDIF
100 CONTINUE
NEFBRN=NSBS
ENDIF
*----
* GET LOCAL BURNUP AND IRRADIATION
*----
IF((NSBS.EQ.0).OR.(ILOCAL.EQ.0).OR.(.NOT.C_ASSOCIATED(IPDEPL)))
1 THEN
RVALOC(:2,:NMERGE,:NEFBRN)=0.0
ELSE
NLOC=2
CALL LCMGET(IPDEPL,'STATE-VECTOR',ISTATE)
IF(ISTATE(3).NE.MXBURN) CALL XABORT('CPODRV: INVALID STATE-VE'
1 //'CTOR.')
NBISO=ISTATE(4)
NREAC=ISTATE(6)
NVAR=ISTATE(7)
NBMIX=ISTATE(8)
CALL LCMGET(IPEDIT,'STATE-VECTOR',ISTATE)
NREG=ISTATE(17)
DO 105 IBR=1,NSBS
IBURN=IBSTEP(IBR)
CALL COMGEN(IPDEPL,IPEDIT,NREG,NMERGE,IBURN,'FLUB',MXBURN,
1 NBMIX,NBISO,NREAC,NVAR,1,NLOC,RVALOC(1,1,IBR))
CALL COMGEN(IPDEPL,IPEDIT,NREG,NMERGE,IBURN,'IRRA',MXBURN,
1 NBMIX,NBISO,NREAC,NVAR,2,NLOC,RVALOC(1,1,IBR))
105 CONTINUE
ENDIF
*----
* INITIALIZE INDPRO FOR MICROSCOPIC XS TO PROCESS
*----
ALLOCATE(VECT(NEDMAC))
VECT(:NEDMAC)=0.0
CALL CPONED(NPROC ,0,NL-1,MAX(1,ILEAKS),NEDMAC,HVECT,VECT,INDPRO)
INDPRO(6)=0
INDPRO(16)=0
ALLOCATE(XSREC(NGROUP*NPROC),XSCAT(NGROUP*NGROUP*NL))
*----
* LOOP OVER BURNUP STEPS
*----
NDUM1=NMERGE*MAX(NIFISS,NGROUP)
NDUM2=NGROUP*NGROUP
MAXDM=MAX(NDUM1,NDUM2)
ALLOCATE(DISFC(NGROUP))
ALLOCATE(XSREM(NGROUP*NPROC),SCREM(NGROUP*NGROUP*NL))
IDFLU=16
MXISOS=0
DO 110 IBR=1,NEFBRN
WRITE(NAMBRN,'(A8,I4)') 'BURN ',IBR
IBURN=IBSTEP(IBR)
IF(IBURN.GT.0) WRITE(CURNAM(9:12),'(I4.4)') IBURN
CALL LCMSIX(IPEDIT,CURNAM,1)
IF(NISCPO.GT.0) CALL LCMGET(IPEDIT,'ISOTOPESDENS',DENTMP)
IF(IPRINT.GE.10) WRITE(IOUT,6000) CURNAM
CALL LCMSIX(IPEDIT,'MACROLIB',1)
CALL LCMGET(IPEDIT,'TIMESTAMP',TMPDAY)
DELERR(1)=CUTOFF*ABS(TMPDAY(1)-TIME(IBR)/8.64E-4)
DELERR(2)=CUTOFF*ABS(TMPDAY(2)-BURN(IBR))
DELERR(3)=CUTOFF*ABS(TMPDAY(3)-WIRRAD(IBR))
IF( (DELERR(1).GT.TMPDAY(1)) .OR.
> (DELERR(2).GT.TMPDAY(2)) .OR.
> (DELERR(3).GT.TMPDAY(3)) ) THEN
IF(TIME(IBR) .EQ. 0.0 .AND.
> BURN(IBR) .EQ. 0.0 .AND.
> WIRRAD(IBR) .EQ. 0.0) THEN
WRITE(IOUT,7001)
ELSE
WRITE(IOUT,7000)
> TMPDAY(1),TIME(IBR)/8.64E-4,DELERR(1)/CUTOFF,
> TMPDAY(2),BURN(IBR),DELERR(2)/CUTOFF,
> TMPDAY(3),WIRRAD(IBR) ,DELERR(3)/CUTOFF
ENDIF
TIME(IBR)=TMPDAY(1)*8.64E-4
BURN(IBR)=TMPDAY(2)
WIRRAD(IBR)=TMPDAY(3)
ENDIF
*----
* READ MACROSCOPIC XS FOR ALL GROUP AND ALL REGIONS
*----
CALL CPOMAR(IPEDIT,NGROUP,NMERGE,NL ,NIFISS,NEDMAC,
> HVECT ,VECT ,NPROC ,ILEAKS,DXSMAC,
> DSCMAC,EMJMAC,DISFC,IFCDIS,DISFAC)
CALL LCMSIX(IPEDIT,'MACROLIB',2)
DENCPO(:NISCPO)=0.0D0
DO 120 IMRG=1,NMERGE
DMJMAC=DBLE(EMJMAC(IMRG))
WRITE(NAMMIX,'(A8,I4)') NAMCPO,IMRG
CALL LCMSIX(IPCPO,NAMMIX,1)
CALL LCMSIX(IPCPO,NAMBRN,1)
IF(IPRINT.GE.10) WRITE(IOUT,6001) NAMMIX
DMJCPO(:2,:NBMICR)=0.0D0
XSREM(:NGROUP*NPROC)=0.0D0
SCREM(:NGROUP*NGROUP*NL)=0.0D0
DO 130 ISOC=1,NBIMRG(IMRG)
ISOR=ICOMIX(IMRG,ISOC)
WRITE(NAMISO,'(3A4)') (ISOCPO(ITC,ISOR),ITC=1,3)
IF(IPRINT.GE.10) WRITE(IOUT,6002) NAMISO
*----
* CREATE AND SAVE XS FOR A CPO ISOTOPE IN CURRENT REGION
*----
CALL LCMSIX(IPCPO,NAMISO,1)
DXSMIC(:NGROUP,:NPROC)=0.0D0
DSCMIC(:NGROUP,:NGROUP,:NL)=0.0D0
CALL CPOMIC(IPCPO ,IPEDIT,IPRINT,NGROUP,NMERGE,NBMICR,
> NL ,IMRG ,ISOR ,NPROC ,ISOTMP,IDIMIX,
> INDPRO,ITYPRO,DENCPO,DENTMP,DXSMIC,DSCMIC,
> DMJCPO,DXSMAC(1,IDFLU,IMRG))
CALL LCMSIX(IPCPO,NAMISO,2)
*----
* REMOVE CONTRIBUTION OF CPO ISOTOPE FROM MACROSCOPIC.
*----
IF(DENCPO(ISOR).GT.0.0D0) THEN
CALL CPOREM(NGROUP,NL ,NPROC ,INDPRO,DENCPO(ISOR),
> DXSMIC,DSCMIC,XSREM ,SCREM )
ENDIF
DMJMAC=DMJMAC-DMJCPO(1,ISOR)
130 CONTINUE
*----
* WRITE MACROSCOPIC XS FOR ALL GROUP IN THIS REGION REGIONS
*----
CALL CPOMAW(IPCPO ,IPRINT,NGROUP,NL ,NPROC ,INDPRO,
> ITYPRO,DXSMAC(1,1,IMRG),DSCMAC(1,1,1,IMRG),
> XSREM,SCREM,DISFC,DMJMAC,IFCDIS,DISFAC)
ALLOCATE(DENSI(NBIMRG(IMRG)+1),EMJI(NBIMRG(IMRG)+1))
DENSI(1)=1.0
EMJI=REAL(DMJMAC)*1.0E-18
DO 140 ISOC=1,NBIMRG(IMRG)
ISOR=ICOMIX(IMRG,ISOC)
DENSI(ISOC+1)=REAL(DENCPO(ISOR))
IF(DMJCPO(2,ISOR).GT.0.0D0) THEN
EMJI(ISOC+1)=1.0E-18*REAL(DMJCPO(1,ISOR)/DMJCPO(2,ISOR))
ELSE
EMJI(ISOC+1)=0.0
ENDIF
140 CONTINUE
CALL LCMPUT(IPCPO,'ISOTOPESDENS',(NBIMRG(IMRG)+1),2,DENSI)
CALL LCMPUT(IPCPO,'ISOTOPES-EFJ',(NBIMRG(IMRG)+1),2,EMJI)
DEALLOCATE(EMJI,DENSI)
CALL LCMSIX(IPCPO,NAMBRN,2)
*----
* PUT REMAINING INFORMATION ON CPO FOR THIS MIXTURE
*----
CALL LCMPUT(IPCPO,'TITLE',18,3,CTITRE)
CALL LCMPUT(IPCPO,'VOLUME',1,2,VOLMER(IMRG))
CALL LCMPUT(IPCPO,'ENERGY',NGROUP+1,2,ENERGY)
IF(IBR.EQ.NEFBRN) THEN
IF(ILOCAL.EQ.1) THEN
DO 145 IBR2=1,NEFBRN
WIRRAD(IBR2)=RVALOC(1,IMRG,IBR2)
BURN(IBR2)=RVALOC(2,IMRG,IBR2)
145 CONTINUE
ENDIF
IF(IPRINT.GT.1) THEN
WRITE(IOUT,7002) IMRG,'IRRA',(WIRRAD(IBR2),IBR2=1,NEFBRN)
WRITE(IOUT,7002) IMRG,'BURN',(BURN(IBR2),IBR2=1,NEFBRN)
ENDIF
CALL LCMPUT(IPCPO,'N/KB ',NEFBRN,2,WIRRAD)
CALL LCMPUT(IPCPO,'BURNUP',NEFBRN,2,BURN)
ALLOCATE(NAMI(3*(NBIMRG(IMRG)+1)))
READ(NAMMAC,'(3A4)') (NAMI(ITC+1),ITC=0,2)
ITC=3
DO 150 ISOC=1,NBIMRG(IMRG)
ISOR=ICOMIX(IMRG,ISOC)
NAMI(ITC+1)=ISOCPO(1,ISOR)
NAMI(ITC+2)=ISOCPO(2,ISOR)
NAMI(ITC+3)=ISOCPO(3,ISOR)
ITC=ITC+3
150 CONTINUE
CALL LCMPUT(IPCPO,'ISOTOPESNAME',3*(NBIMRG(IMRG)+1),3,NAMI)
NAMI(:NBIMRG(IMRG)+1)=0
CALL LCMPUT(IPCPO,'JTAB',(NBIMRG(IMRG)+1),1,NAMI)
DEALLOCATE(NAMI)
IPARAM(:NPARAM)=0
IPARAM(1)=NGROUP
IPARAM(2)=NBIMRG(IMRG)+1
IPARAM(3)=NL
IPARAM(4)=NEFBRN
MXISOS=MAX(MXISOS,NBIMRG(IMRG)+1)
CALL LCMPUT(IPCPO,'PARAM',NPARAM,1,IPARAM)
ENDIF
CALL LCMSIX(IPCPO,NAMMIX,2)
120 CONTINUE
CALL LCMSIX(IPEDIT,CURNAM,2)
110 CONTINUE
ISTATE(:NSTATE)=0
ISTATE(1)=NMERGE
ISTATE(2)=NGROUP
ISTATE(3)=MXISOS
ISTATE(4)=NL
ISTATE(5)=NEFBRN
ISTATE(6)=NPARAM
ISTATE(7)=IFCDIS
CALL LCMPUT(IPCPO,'STATE-VECTOR',NSTATE,1,ISTATE)
DEALLOCATE(SCREM,XSREM,DISFC)
IF(NISCPO.GT.0) DEALLOCATE(XSCAT,XSREC,VECT)
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(DISFAC,DMJCPO,DSCMAC,DXSMAC,DSCMIC,DXSMIC,DENCPO)
DEALLOCATE(RVALOC,EMJMAC,DENTMP)
DEALLOCATE(ITYPRO,INDPRO)
RETURN
*----
* PRINT FORMAT
*----
6000 FORMAT(' CPODRV: STEPPING UP ON DIRECTORY = ',A12)
6001 FORMAT(' CPODRV: CREATING MIXTURE = ',A12)
6002 FORMAT(' CPODRV: CREATING ISOTOPE = ',A12)
*----
* WARNING FORMAT
*----
7000 FORMAT(
> ' CPODRV: WARNING -> BURNUP AND EDIT DATA DIFFER',1P/
> ' TIME: EDIT=',E15.7,5X,' BURNUP=',E15.7,' DIFF=',E15.7/
> ' BURN: EDIT=',E15.7,5X,' BURNUP=',E15.7,' DIFF=',E15.7/
> ' WIRR: EDIT=',E15.7,5X,' BURNUP=',E15.7,' DIFF=',E15.7/
> ' USE EDIT DATA ')
7001 FORMAT(
> ' CPODRV: WARNING -> 0 BURNUP STEP, USE EDIT DATA')
7002 FORMAT(/13H CPODRV: MIX=,I4,3X,A,1H=,1P,6E12.4/(25X,6E12.4))
END
|
