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
|
*DECK HSTUHB
SUBROUTINE HSTUHB(IPHST, IPEVO, IPRINT, MAXI, NBBTS, NCHA,
> NBUN, IUPDC, IUPDB, IDCELL, IDFUEL, DENI,
> MAXL, PARAML)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To update the HISTORY data structure using the information
* provided on the BURNUP data structure.
*
*Copyright:
* Copyright (C) 2003 Ecole Polytechnique de Montreal.
*
*Author(s):
* G. Marleau, E. Varin
*
*Parameters: input
* IPHST address of the \dds{history} data structure.
* IPEVO address of the \dds{burnup} data structure.
* IPRINT print level.
* MAXI maximum number of isotopes.
* NBBTS number of depletion steps.
* NCHA number of fuel channels.
* NBUN number of bundles per channel.
* IUPDC number of the channel to analyze.
* IUPDB number of the bundle to analyze.
* IDCELL cell identifier for each fuel bundle in each channel.
* IDFUEL fuel type identifier for each fuel bundle in each channel.
* IPHST pointer to the HISTORY data structure
* IPEVO pointer to the BURNUP data structure.
* IPRINT print level.
* MAXI maximum number of isotopes.
* NBBTS number of depletion steps.
* NCHA number of fuel channels.
* NBUN number of bundles per channels.
* IUPDC channel number to process or update.
* IUPDB bundle number to process or update.
* IDCELL list of cell identifiers.
* IDFUEL list of fuel type identifiers.
* MAXL maximum number of local parameters.
*
*Parameters: work
* PARAML local parameters.
* DENI isotopic concentrations of the isotopes
* on the \dds{burnup} or \dds{history} structure.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPHST,IPEVO
INTEGER IPRINT,MAXI,NBBTS,MAXL
INTEGER NCHA,NBUN,IUPDC,IUPDB
INTEGER IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
REAL DENI(0:MAXI)
REAL PARAML(0:MAXL,2)
*----
* LOCAL PARAMETERS
* CDAY = conversion of days in 10^{8} seconds
*----
INTEGER IOUT
INTEGER ILCMUP,ILCMDN
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUHB')
REAL CDAY,TIMPOW(2)
PARAMETER (CDAY=8.64E-4)
*----
* LOCAL VARIABLES
*----
INTEGER ILCMLN,ILCMTY
CHARACTER NAMTIM*12,NAMP*12
INTEGER IFT,ICT,INEWF,INEWC
INTEGER ITS,ISO,IOK
REAL BITH(3),BITB(3)
REAL FDENC(2),FDENF(2),FDENB(2)
REAL REVOL(5)
INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXIH,MIXIB
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMIH,NAMIB
REAL, ALLOCATABLE, DIMENSION(:) :: DEPLT
*----
* SCRATCH STORAGE ALLOCATION
* NAMIH name of isotopes on the \dds{history} structure.
* MIXIH mixture number associated with the isotopes
* on the \dds{history} structure.
* NAMIB name of isotopes on the \dds{burnup} structure.
* MIXIB mixture number associated with the isotopes
* on the \dds{burnup} structure.
* DEPLT time associated with each depletion step
* on the \dds{burnup} structure.
*----
ALLOCATE(NAMIH(3,0:MAXI),MIXIH(0:MAXI),NAMIB(3,0:MAXI),
> MIXIB(0:MAXI),DEPLT(0:NBBTS))
*----
* Initialize test flags
* INEWF -> new fuel type flag
* = 0 fuel type does not exists/create it
* = 1 fuel exists but does not contain isotopes
* = 2 fuel type exists and contains isotopes
* INEWC -> new cell type flag
* = 0 cell type does not exists/create it
* = 1 cell type exists but isotopes densities missing
* = 2 cell type exists and contains isotope densities
*----
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6000) NAMSBR
ENDIF
INEWF=2
INEWC=2
DENI(0:MAXI)=0.0
PARAML(0:MAXL,:2)=0.0
BITH(:3)=0.0
BITB(:3)=0.0
FDENC(:2)=0.0
FDENF(:2)=0.0
FDENB(:2)=0.0
*----
* Read HISTORY information for cell specified
*----
IF(IUPDC .GT. 0 .AND. IUPDB .GT. 0) THEN
*----
* Read isotope names and mixtures on FUEL TYPE
* if available
*----
IFT=IDFUEL(IUPDB,IUPDC)
WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT
CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
IF(ILCMLN .EQ. 0) THEN
INEWF=0
ELSE
CALL LCMSIX(IPHST,NAMP,ILCMUP)
CALL LCMLEN(IPHST,'ISOTOPESUSED',ILCMLN,ILCMTY)
IF(ILCMLN .GT. 0 .AND. ILCMLN .LT. 3*MAXI*4) THEN
CALL LCMGET(IPHST,'ISOTOPESUSED',NAMIH(1,1))
CALL LCMGET(IPHST,'ISOTOPESMIX',MIXIH(1))
CALL LCMGET(IPHST,'FUELDEN-INIT',FDENF)
ELSE
INEWF=1
ENDIF
CALL LCMSIX(IPHST,NAMP,ILCMDN)
ENDIF
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6001) 'FUEL TYPE',IFT
IF(INEWF .EQ. 2) THEN
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6010)
WRITE(IOUT,6011)
> (NAMIH(1,ISO),NAMIH(2,ISO),NAMIH(3,ISO),ISO=1,MAXI)
WRITE(IOUT,6020)
WRITE(IOUT,6021)
> (MIXIH(ISO),ISO=1,MAXI)
ENDIF
ENDIF
ENDIF
*----
* Read isotope densities on CELL TYPE
* if available
*----
ICT=IDCELL(IUPDB,IUPDC)
WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
IF(ILCMLN .EQ. 0) THEN
INEWC=0
ELSE
CALL LCMSIX(IPHST,NAMP,ILCMUP)
IOK=-1
CALL HSTGSD(IPHST ,MAXI ,IOK ,DENI ,FDENC )
INEWC=1
IF(IOK .EQ. 0) THEN
INEWC=2
CALL LCMGET(IPHST,'DEPL-PARAM ',BITH)
ENDIF
CALL LCMSIX(IPHST,NAMP,ILCMDN)
ENDIF
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6001) 'CELL TYPE',ICT
IF(INEWF .EQ. 2) THEN
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6100)
WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI)
ENDIF
ENDIF
ENDIF
*----
* Read isotopes names and mixtures on BURNUP
*----
CALL LCMGET(IPEVO,'ISOTOPESUSED',NAMIB(1,1))
CALL LCMGET(IPEVO,'ISOTOPESMIX ',MIXIB(1))
CALL LCMGET(IPEVO,'FUELDEN-INIT',FDENB)
*----
* Test for coherence of isotopes names and mixture
* between HISTORY and BURNUP if fuel type contains
* isotopes description
*----
IF(INEWF .EQ. 2) THEN
DO 100 ISO=1,MAXI
IF(NAMIH(ISO,1) .NE. NAMIB(ISO,1) .OR.
> NAMIH(ISO,2) .NE. NAMIB(ISO,2) .OR.
> NAMIH(ISO,3) .NE. NAMIB(ISO,3) .OR.
> MIXIH(ISO) .NE. MIXIB(ISO) ) THEN
CALL XABORT(NAMSBR//
> ': Isotopes on HISTORY and BURNUP not coherent')
ENDIF
100 CONTINUE
IF(FDENF(1) .NE. FDENB(1) .OR.
> FDENF(2) .NE. FDENB(2) ) THEN
CALL XABORT(NAMSBR//
> ': Fuel DENSITY on HISTORY and BURNUP not coherent')
ENDIF
ENDIF
*----
* Read calculation types on BURNUP
*----
CALL LCMGET(IPEVO,'EVOLUTION-R ',REVOL)
DEPLT(0:NBBTS)=0.0
CALL LCMGET(IPEVO,'DEPL-TIMES ',DEPLT(1))
*----
* Read initial burnup information (FOR FUEL TYPE)
* and save
*----
ITS=1
IF(INEWF .NE. 2 ) THEN
BITB(1)=DEPLT(ITS)/CDAY
IF(BITB(1) .EQ. 0.0) THEN
WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS
CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
CALL LCMGET(IPEVO,'ISOTOPESDENS',DENI(1))
CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2))
CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
ELSE
CALL XABORT(NAMSBR//
> ': Initial DENSITY on BURNUP required')
ENDIF
*----
* Save isotopes names and mixtures for FUEL type
*----
WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT
CALL LCMSIX(IPHST,NAMP,ILCMUP)
CALL LCMPUT(IPHST,'ISOTOPESUSED',3*MAXI,3,NAMIB(1,1))
CALL LCMPUT(IPHST,'ISOTOPESMIX',MAXI ,1,MIXIB(1))
CALL LCMPUT(IPHST,'FUELDEN-INIT',2 ,2,FDENB)
CALL LCMPUT(IPHST,'ISOTOPESDENS',MAXI ,2,DENI(1))
CALL LCMSIX(IPHST,NAMP,ILCMDN)
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6010)
WRITE(IOUT,6011)
> (NAMIB(1,ISO),NAMIB(2,ISO),NAMIB(3,ISO),ISO=1,MAXI)
WRITE(IOUT,6020)
WRITE(IOUT,6021)
> (MIXIB(ISO),ISO=1,MAXI)
ENDIF
ELSE
BITB(1)=DEPLT(ITS)/CDAY
WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS
CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2))
CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
*----
* Test if initial BURNUP coherent with old history
*----
IF(INEWC .EQ. 2 ) THEN
IF(BITB(1) .NE. BITH(1) .OR.
> BITB(2) .NE. BITH(2) .OR.
> BITB(3) .NE. BITH(3) ) THEN
WRITE(IOUT,6200) BITH(1)
ENDIF
ENDIF
ENDIF
ITS=NBBTS
BITB(1)=DEPLT(ITS)/CDAY
WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS
CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
CALL LCMGET(IPEVO,'ISOTOPESDENS',DENI(1))
CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2))
CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
*----
* Save power desnity and depletion time in History
* Modif EV 04/11/09
*----
WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
CALL LCMSIX(IPHST,NAMP,ILCMUP)
IOK=-2
CALL HSTGSL(IPHST ,MAXL ,IOK ,TIMPOW,PARAML(0,1))
IF(IOK .NE. 0) PARAML(0:MAXL,1)=0.0
IOK=2
TIMPOW(1)= DEPLT(NBBTS)/CDAY
TIMPOW(2)= REVOL(5)
CALL HSTGSL(IPHST ,MAXL ,IOK ,TIMPOW,PARAML(0,1))
*----
* Save last densities on BURNUP
*----
IOK=2
CALL HSTGSD(IPHST ,MAXI ,IOK ,DENI ,FDENB )
CALL LCMPUT(IPHST,'DEPL-PARAM ',3,2,BITB)
CALL LCMSIX(IPHST,NAMP,ILCMDN)
IF(IPRINT .GE. 100) THEN
WRITE(IOUT,6101)
WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI)
ENDIF
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(DEPLT,MIXIB,NAMIB,MIXIH,NAMIH)
*----
* Return
*----
RETURN
*----
* FORMAT
*----
6000 FORMAT(' ****** OUTPUT FROM ',A6)
6001 FORMAT(' Contents of ',A9,1X,I8)
6010 FORMAT(' NAME OF ISOTOPES ')
6011 FORMAT(10(3A4,2X))
6020 FORMAT(' MIXTURE OF ISOTOPES ')
6021 FORMAT(10(I12,2X))
6100 FORMAT(' INITIAL DENSITIES')
6101 FORMAT(' FINAL DENSITIES')
6110 FORMAT(1P,10E14.7)
6200 FORMAT(' Update cell densities with no chronological burnup'/
+ ' Old time ',F6.2,' days should be zero.'/
+ ' Possible errors or restart case')
END
|
