summaryrefslogtreecommitdiff
path: root/Donjon/src/HSTREF.f
blob: 50c9b4f4de756f1afce99dd9a897da2664656be5 (plain)
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
*DECK HSTREF
      SUBROUTINE HSTREF(IPHST,  IPRINT, MAXL,   NCHA,   NBUN,   MAXI,
     >                  DELTAT, POWER,  IREFUS, REFUT,  IDCELL, IDFUEL,
     >                  PARAML, DENI,   ISHUFF)
*
*----------
*
*Purpose:
* Refuel channel by performing fuel shuffling. 
*
*Copyright:
* Copyright (C) 2003 Ecole Polytechnique de Montreal.
*
*Author(s): 
* G. Marleau, E. Varin
*
*Parameters: input
* IPHST   address of the \dds{history} data structure.
* IPRINT  print level.
* MAXL    maximum number of local parameters.                   
* NCHA    number of fuel channels.                   
* NBUN    number of bundles per channel.            
* MAXI    maximum number of isotopes.            
* DELTAT  last character string read.
* POWER   burnup power for each fuel bundle in each channel.
* IREFUS  refueling strategy for each channel.
*         refueling strategy for each channel.
*         A channel is refueled using a NBS bundle 
*         shift procedure if IREFUS(I)=NBS. 
*         In the case where NBS $>$ 0,
*         bundles 1 to NBUN-NBS are displaced to position NBS+1 to
*         NBUN while locations 1 to NBS are filled with new fuel. 
*         In the case where NBS $<$ 0,
*         bundles -NBS+1 to NBUN are displaced to position 1 to
*         NBUN+NBS while locations NBUN+NBS+1 to NBUN are filled 
*         with new fuel.
* REFUT   refueling time for each channel.
*
*Parameters: input/output
* IDCELL  cell identifier for each fuel bundle in each channel.
* IDFUEL  fuel type identifier for each fuel bundle in each channel.
*
*Parameters: work
* PARAML  local parameters.
* DENI    isotopic concentrations.
* ISHUFF  fuel shuffling index for a channel.
*
*----------
*
      USE GANLIB
      IMPLICIT         NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR)      IPHST
      INTEGER          IPRINT,MAXL,NCHA,NBUN,MAXI
      REAL             DELTAT
      REAL             POWER(NCHA,NBUN)
      INTEGER          IREFUS(NCHA)
      REAL             REFUT(NCHA)
      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
      REAL             PARAML(0:MAXL,2)
      REAL             DENI(0:MAXI)
      INTEGER          ISHUFF(NBUN)
*----
*  LOCAL PARAMETERS
*----
      INTEGER          IOUT,NTC,ILCMUP,ILCMDN
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
     >                 NAMSBR='HSTREF')
*----
*  LOCAL VARIABLES
*----
      INTEGER          IC,IB,IBS,IBO,ICT,IFT,IOK
      REAL             FDEN(2)
      REAL             TIMREF,TIMPOW(2)
      CHARACTER        NAMP*12 
*----
*  Take local paremeters after fueling
*  and store in local parameters before fueling
*  for all fuel cells
*----
      IF(IPRINT .GE. 10) THEN
        WRITE(IOUT,7000) NAMSBR
      ENDIF
      DO 100 IC=1,NCHA
        TIMREF=REFUT(IC)
        IBS=IREFUS(IC) 
        DO 110 IB=1,NBUN
          ICT=IDCELL(IB,IC)
          WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
          CALL LCMSIX(IPHST,NAMP,ILCMUP)
*----
*  Get local parameters from cell IB after refueling
*----
          IOK=-2              
          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
          IF(IOK .NE. 0) PARAML(0:MAXL,1)=0.0
*----
*  Save local parameters from cell IB before refueling
*----         
          IOK=1
          TIMPOW(1)=TIMREF
          TIMPOW(2)=POWER(IC,IB)
          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML)
          IOK=2
          TIMPOW(1)=DELTAT-TIMREF
          TIMPOW(2)=POWER(IC,IB)
          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML)
          CALL LCMSIX(IPHST,NAMP,ILCMDN)
 110    CONTINUE
*----
*  Look for channel to refuel  
*  -> REFUT(IC) > 0.0
*  Refuel channel according to IREFUS(IC) bundle shift
*  IREFUS(IC) < 0  -> push bundles starting at I=NBUN side
*  IREFUS(IC) > 0  -> push bundles starting at I=1    side
*  For displaced fuel channels:
*     Change IDCELL to new cell identifier after displacement
*  For refuel channels 
*     Use IDCELL for channels removed from core and allocate
*     then to new fuel. 
*----
        IF(TIMREF .GT. 0.0) THEN
          IF(IPRINT .GE. 10) THEN
            WRITE(IOUT,7001) IC,IBS
          ENDIF
*----
*  Find ISHUFF(IB)=IBO
*  IBO > 0 is the position of the bundle IB before refueling
*  IBO < 0 is the free position availables for refueling
*----
          ISHUFF(:NBUN)=0
          IF(IBS .GT. 0) THEN 
*----
*  push bundles starting at I=1 side
*  with +IBS > 0 bundle shifts
*  1) Displaced bundles :  position  1     -- NBUN-IBS 
*                       :  position  IBS+1 -- NBUN
*----
            IBO=0
            DO 120 IB=IBS+1,NBUN
              IBO=IBO+1
              ISHUFF(IB)=IBO
 120        CONTINUE 
*----
*  2) Inserted bundles  :  positions 1     -- IBS
*----
            IBO=NBUN-IBS
            DO 121 IB=1,IBS
              IBO=IBO+1
              ISHUFF(IB)=-IBO
 121        CONTINUE
          ELSE IF(IBS .LT. 0) THEN 
*----
*  push bundles starting at I=NBUN  side
*  with -IBS > 0 bundle shifts
*  1) Displaced bundles :  position  -IBS +1     -- NBUN
*                       :  position  1          -- NBUN+IBS
*----
            IBO=-IBS
            DO 130 IB=1,NBUN+IBS
              IBO=IBO+1
              ISHUFF(IB)=IBO
 130        CONTINUE
*----
*  2) Inserted bundles  :  positions NBUN+IBS+1 -- NBUN 
*----
            IBO=0
            DO 131 IB=NBUN+IBS+1,NBUN
              IBO=IBO+1
              ISHUFF(IB)=-IBO
 131        CONTINUE
          ENDIF
*----
*  treat refueling
*----
          DO 140 IB=1,NBUN
*----
*  Get local parameters from cell IB before refueling
*----
            ICT=IDCELL(IB,IC)
            WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
            CALL LCMSIX(IPHST,NAMP,ILCMUP)
            IOK=-1              
            CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
            CALL LCMSIX(IPHST,NAMP,ILCMDN)
*
            IBO=ISHUFF(IB)
            IF(IBO .GT. 0) THEN 
*----
*  Scan Displaced bundles
*  and save properties at old cell location
*----
              IF(IPRINT .GE. 10) THEN
                WRITE(IOUT,7010) IBO,IB
              ENDIF
*----
*  Save local parameters to cell IBO after refueling
*----         
              ICT=IDCELL(IBO,IC)
              WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
              CALL LCMSIX(IPHST,NAMP,ILCMUP)
              IOK=2
              TIMPOW(1)=DELTAT-TIMREF
              TIMPOW(2)=POWER(IC,IB)
              CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
              CALL LCMSIX(IPHST,NAMP,ILCMDN)
*----
*  Save in ISHUFF IDCELL for IBO
*----         
           ELSEIF(IBO .LT. 0) THEN
*----
*  Scan inserted fuel
*  and save properties at reused cell location
*----
              IF(IPRINT .GE. 10) THEN
                WRITE(IOUT,7011) IB
              ENDIF
              IBO=-IBO
*----
*  Get initial density for fuel type
*----         
              IFT=IDFUEL(IB,IC)
              WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT
              CALL LCMSIX(IPHST,NAMP,ILCMUP)
              IOK=-1              
              CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDEN   )
              CALL LCMSIX(IPHST,NAMP,ILCMDN)
*----
*  Save local parameters before and after refueling
*  from cell IBO before refueling
*  Save fuel density for fuel type
*----         
              ICT=IDCELL(IBO,IC)
              WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
              CALL LCMSIX(IPHST,NAMP,ILCMUP)
              IOK=1
              TIMPOW(1)=0.0
              TIMPOW(2)=POWER(IC,IB)
              CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
              IOK=2
              TIMPOW(1)=DELTAT-TIMREF
              TIMPOW(2)=POWER(IC,IB)
              CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
              IOK=2
              CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDEN  )
              CALL LCMSIX(IPHST,NAMP,ILCMDN)
*----
*  Save in ISHUFF IDCELL for IBO
*----         
            ENDIF
              ISHUFF(IB)=ICT
 140      CONTINUE
*----
*  Redefine IDCELL for new spatial location
*  of cells after refueling
*  Here assume that bundles are replaced
*  with fuels of the same type
*----
          DO 160 IB=1,NBUN
            IDCELL(IB,IC)=ISHUFF(IB)
 160      CONTINUE
        ENDIF
 100  CONTINUE 
*----
*  Save IDCELL and IDFUEL since they were updated
*----
      CALL LCMPUT(IPHST,'CELLID      ',NBUN*NCHA,1,IDCELL)
      CALL LCMPUT(IPHST,'FUELID      ',NBUN*NCHA,1,IDFUEL)
*----
*  Return
*----
      RETURN
*----
* Format
*----
 7000 FORMAT(' ***** OUTPUT FROM ',A6,' *****')
 7001 FORMAT(' Refueling channel ',I8, ' with ',I8,' bundle shifts')
 7010 FORMAT(10X,' Fuel bundle ',I8,' displaced to position ',I8)
 7011 FORMAT(10X,' Fresh fuel inserted at position ',I8)
      END