summaryrefslogtreecommitdiff
path: root/Donjon/src/HSTGET.f
blob: 6a1238a67e26126ff2bc0f2817cf8917675045bd (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
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
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
*DECK HSTGET
      SUBROUTINE HSTGET(IPHST,  IPRINT, MAXG,   MAXL,   NCHA,   NBUN,
     >                  ITYPRO, ITYRED, CARRED, IUPDC,  IUPDB,
     >                  NAMG,   PARAMG, NAML,   PARAML, IDCELL, IDFUEL)
*
*----------
*
*Purpose:
* To read from the input file or send to CLE-2000 variables the 
* local and burnup parameters associated with a fuel cell.
*
*Copyright:
* Copyright (C) 2003 Ecole Polytechnique de Montreal.
*
*Author(s): 
* G. Marleau
*
*Parameters: input
* IPHST   address of the \dds{history} data structure.
* IPRINT  print level.
* MAXG    maximum number of global parameters.                   
* MAXL    maximum number of local parameters.                   
* NCHA    number of fuel channels.                   
* NBUN    number of bundles per channel.
* ITYPRO  type of processing where:
*         ITYPRO > 0 if history is in creation or update mode; 
*         ITYPRO < 0 if history is in read-only mode. 
* ITYRED  type of the last variable read.                
* CARRED  last character string read.
*
*Parameters: input/output
* NMAG    global parameter names.
* PARAMG  values of the global parameters.
* NMAL    local parameter names.
* PARAML  values of the local parameters.
* IDCELL  cell identifier for each fuel bundle in each channel.
* IDFUEL  fuel type identifier for each fuel bundle in each channel.
*
*Parameters: output
* IUPDC   number of the channel to analyze.                   
* IUPDB   number of the bundle to analyze.
*
*----------
*
      USE GANLIB
      IMPLICIT         NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR)      IPHST
      INTEGER          IPRINT,MAXG,MAXL,NCHA,NBUN,ITYPRO
      INTEGER          ITYRED,IUPDC,IUPDB
      CHARACTER        CARRED*12
      INTEGER          NAMG(3,0:MAXG),NAML(3,0:MAXL)
      REAL             PARAMG(0:MAXG),PARAML(0:MAXL,2)
      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
*----
*  LOCAL PARAMETERS
*----
      INTEGER          IOUT,NTC,ILCMUP,ILCMDN
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
     >                 NAMSBR='HSTGET')
*----
*  INPUT/OUTPUT VARIABLES 
*  Input data is of the form
*  [ GET (hstpar) ] [ PUT (hstpar) ]
*  [ CELLID icha ibun  [ idfuel ] 
*      [ GET (hstpar) ] 
*      [ PUT { BREFL  (hsrbrn) (hstpar) 
*              AREFL   (hsrbrn) (hstpar)   |
*            [ AREFL ] (hsrbrn) (hstpar)   } ] ]
*
*  HERE:
*  (hstpar)           = NAMPAR valpar
*                       where NAMPAR is the name of a local or global
*                       parameter and valpar its value.
*  (hstbrn)           = BURN period power
*                       where period is the burnup time step 
*                       and power the burnup power density in kW/kg.
*  For global parameter:
*  GET                = implies that (hstpar) is transfered to the 
*                       HISTORY file, 
*  PUT                = implies that (hstpar) is transfered to
*                       CLE-2000 variables. 
*  For local parameters:
*  GET                = implies that (hstpar) is transfered to the 
*                       HISTORY file for the case before and
*                       after refueling.
*  PUT                = implies that (hstbrn) and (hstpar)  
*                       are transfered to CLE-2000 variables. 
*  BREFL              = Indicates that the information before
*                       refueling is considered.
*  AREFL              = Indicates that the information after
*                       refueling is considered.
*                       This is the default option is neither
*                       BREFL nor AREFL is defined.
*----
      INTEGER          ITYPLU,INTLIR
      CHARACTER        CARLIR*12
      REAL             REALIR
      DOUBLE PRECISION DBLLIR
      INTEGER          ITYPUT,INTPUT
      CHARACTER        CARPUT*12
      REAL             REAPUT
      DOUBLE PRECISION DBLPUT
*----
*  LOCAL VARIABLES
*----                  
      INTEGER          ICONTR,IGP,IFTN,ISREF,IUPDL,IUPDG,IUPDF
      INTEGER          ITC,INEXT,IB,IC,IPL,IP
      INTEGER          ICT,IOK
      CHARACTER        NAMP*12
      REAL             TIMPOW(2,2)
*----
*  Initialize input vectors
*----
      PARAML(0:MAXL,:2)=0.0
      TIMPOW(:2,:2)=0.0
*----
*  Initialize variables
*  IUPDC  -> channel number to process or update.
*  IUPDB  -> bundle number to process or update.
*  ICONTR -> indicates processing of ITYRED and CARRED
*            = 0 processing required.
*            = 1 processing has been performed.
*  IGP    -> indicate if a GET or PUT command is in effect.
*            =-1 PUT command in effect
*            = 0 no GET or PUT command in effect
*            = 1 GET command in effect 
*  IFTN      = new fuel type 
*  ISREF  -> indicate the REFUEL state
*            is to be processed
*            = 0 no processing
*            = 1 processing before refuel
*            = 2 processing after refuel 
*  IUPDL  -> indicates local parameters update 
*            = 0 no update
*            > 0 updated
*  IUPDG  -> indicates global parameters update 
*            = 0 no update
*            > 0 updated 
*  IUPDF  -> Fuel type update
*            = 0 no update
*            > 0 updated
*----  
      IUPDC=0
      IUPDB=0
      ICONTR=0
      IGP   =0
      IFTN  =0
      ISREF =0
      IUPDL =0 
      IUPDG =0
      IUPDF =0 
 100  CONTINUE
      IF(ICONTR .EQ. 0) THEN
        ITYPLU=ITYRED
        CARLIR=CARRED
        ICONTR=1
      ELSE
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
      ENDIF
 101  CONTINUE
      IF(ITYPLU .EQ. 10) GO TO 105
      IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
     >': Read error -- Character variable expected')
      IF(CARLIR .EQ. ';') THEN
        GO TO 105 
      ELSE IF(CARLIR .EQ. 'CELLID') THEN
        IGP=0
*----
*  Channel number
*----
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
     >  ': Read error -- integer value for channel number expected.')
        IF(INTLIR .LT. 0 ) CALL XABORT(NAMSBR//
     >  ': Read error -- value for channel number must be > 0.')
        IF(IUPDC .NE. 0) CALL XABORT(NAMSBR//
     >  ': Only one channel can be updated for each call to HST.')
        IUPDC=INTLIR
*----
*  Bundle number
*----
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
     >  ': Read error -- integer value for bundle number expected.')
        IF(INTLIR .LT. 0 ) CALL XABORT(NAMSBR//
     >  ': Read error -- value for bundle number must be > 0')
        IF(IUPDB .NE. 0) CALL XABORT(NAMSBR//
     >  ': Only one bundle can be updated for each call to HST.')
        IUPDB=INTLIR 
*----
*  Fuel type (optional)
*----
        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR) 
        IFTN=-1
        IF(ITYPLU .EQ. 1) THEN
          IFTN=INTLIR
          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
        ENDIF
*----
*  IF CELL IS NOT IDENTIFIED ASSOCIATE TO CELL NEXT 
*  CELL NUMBER AVAILABLE AND TO FUEL TYPE
*  VALUE PROVIDED IN IFTN
*----   
        IF(IDCELL(IUPDB,IUPDC) .LE. 0) THEN
          DO 110 INEXT=1,NBUN*NCHA
            DO 111 IB=1,NBUN
              DO 112 IC=1,NCHA
                IF(IDCELL(IB,IC) .EQ. INEXT) GO TO 115
 112          CONTINUE
 111        CONTINUE
            IDCELL(IUPDB,IUPDC)=INEXT
            GO TO 116
 115        CONTINUE
 110      CONTINUE
          CALL XABORT(NAMSBR//': No cell id available')
 116      CONTINUE
          IDFUEL(IUPDB,IUPDC)=ABS(IFTN) 
        ELSE
*----
*  CELL EXIST, READ IF POSSIBLE EXISTING LOCAL 
*  PARAMETERS VALUES
*----     
          ICT=IDCELL(IUPDB,IUPDC)
          WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
          CALL LCMSIX(IPHST,NAMP,ILCMUP)
*----
*  Get local parameters from cell before refueling
*----
          IOK=-1              
          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,
     >                TIMPOW(1,1)  ,PARAML(0,1)) 
          IF((IPRINT.GT.0).AND.(IOK.NE.0)) THEN
            WRITE(IOUT,7000) NAMSBR
            WRITE(IOUT,7010) IUPDC,IUPDB,'BEFORE'
          ENDIF
*----
*  Get local parameters from cell after refueling
*----
          IOK=-2              
          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,
     >                TIMPOW(1,2)  ,PARAML(0,2)) 
          IF((IPRINT.GT.0).AND.(IOK.NE.0)) THEN
            WRITE(IOUT,7000) NAMSBR
            WRITE(IOUT,7010) IUPDC,IUPDB,'AFTER '
          ENDIF
          CALL LCMSIX(IPHST,NAMP,ILCMDN)
        ENDIF
        GO TO 101   
      ELSE IF(CARLIR .EQ. 'GET') THEN
        IF(ITYPRO .LT. 0) CALL XABORT(NAMSBR//
     >': Option GET not permitted for history in read only mode')
        IGP=1
        ISREF=2
      ELSE IF(CARLIR .EQ. 'PUT') THEN
        IGP=-1
        ISREF=2
      ELSE IF(CARLIR .EQ. 'BREFL') THEN
        IF(IGP .NE. -1) CALL XABORT(NAMSBR//
     >': Option BREFL permitted for PUT only')
        ISREF=1
      ELSE IF(CARLIR .EQ. 'AREFL') THEN
        IF(IGP .NE. -1) CALL XABORT(NAMSBR//
     >': Option AREFL permitted for PUT only')
        ISREF=2
      ELSE
        IF(IGP .EQ. 0) CALL XABORT(NAMSBR//
     >  ': GET or PUT must be specified ')
        IF(IUPDC*IUPDB .GT. 0) THEN
*----
*  CARLIR contains a local parameter
*----
          IF(CARLIR .EQ. 'BURN') THEN 
            IF(IGP .EQ. 1) CALL XABORT(NAMSBR//
     >': Option GET not permitted for BURN keyword')
            IF(ITYPRO .GT. 0) CALL XABORT(NAMSBR//
     >': Option BURN permitted only for history in read only mode')
            REAPUT=TIMPOW(1,ISREF)
            ITYPUT=2
            CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
            IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
     >': Real output variable for burnup period expected')
            CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
*----
*  The power density expected is in kW/kg.
*----
            REAPUT=TIMPOW(2,ISREF)
            ITYPUT=2
            CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
            IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
     >': Real output variable for burnup power expected')
            CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
          ELSE
*----
*  Scan local parameters to see is CARLIR is one of them
*----       
            IP=0
            DO 120 IPL=1,MAXL
              WRITE(NAMP,'(3A4)') (NAML(ITC,IPL),ITC=1,NTC)
              IF(NAMP .EQ. CARLIR) THEN
                IP=IPL
                GO TO 125
              ELSE IF(NAMP .EQ. '            ') THEN 
                IP=IPL
                READ(CARLIR,'(3A4)') (NAML(ITC,IP),ITC=1,NTC)
                GO TO 125
              ENDIF
 120        CONTINUE
            CALL XABORT(NAMSBR//': Number of local parameters '//
     >      'provided larger than number permitted.') 
 125        CONTINUE
            IF(IGP .EQ. -1) THEN
              REAPUT=PARAML(IP,ISREF)
              ITYPUT=2
              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
              IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
     >':  Real output variable for local parameter expected')
              CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
            ELSE IF(IGP .EQ. 1) THEN
              IUPDL=IUPDL+1
              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
              IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
     >        ': Real value for local parameter missing.')
              PARAML(IP,ISREF)=REALIR 
            ENDIF
          ENDIF
        ELSE
*----
*  CARLIR contains a global parameter
*----
          IF(CARLIR .EQ. 'POWER') THEN
            CALL XABORT(NAMSBR//
     >      ': POWER is a local not global parameter') 
          ELSE 
            IP=0
            DO 130 IPL=1,MAXG
              WRITE(NAMP,'(3A4)') (NAMG(ITC,IPL),ITC=1,NTC)
              IF(NAMP .EQ. CARLIR) THEN
                IP=IPL
                GO TO 135
              ELSE IF(NAMP .EQ. '            ') THEN 
                IP=IPL
                READ(CARLIR,'(3A4)') (NAMG(ITC,IP),ITC=1,NTC)
                GO TO 135
              ENDIF
 130        CONTINUE
            CALL XABORT(NAMSBR//': Number of global parameters '//
     >      'provided larger than number permitted.') 
 135        CONTINUE
            IF(IGP .EQ. -1) THEN
              REAPUT=PARAMG(IP)
              ITYPUT=2
              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
              IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
     >':  Real output variable for global parameter expected')
              CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
            ELSE IF(IGP .EQ. 1) THEN
              IUPDG=IUPDG+1
              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
              IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
     >        ': Real value for global parameter missing.')
              PARAMG(IP)=REALIR 
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      GO TO 100
 105  CONTINUE
*----
*  Save global parameters if some are updated
*----
      IF(IUPDG .GT. 0) THEN 
        CALL LCMPUT(IPHST,'NAMEGLOBAL  ',3*MAXG,3,NAMG(1,1))
        CALL LCMPUT(IPHST,'PARAMGLOBAL ',MAXG,2,PARAMG(1))
      ENDIF       
      IF(IUPDL .GT. 0) THEN 
        CALL LCMPUT(IPHST,'NAMELOCAL   ',3*MAXL,3,NAML(1,1))
        ICT=IDCELL(IUPDB,IUPDC)
        WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
        CALL LCMSIX(IPHST,NAMP,ILCMUP)
        IOK=2              
        CALL HSTGSL(IPHST ,MAXL  ,IOK   ,
     >              TIMPOW(1,2)  ,PARAML(0,2)) 
        CALL LCMSIX(IPHST,NAMP,ILCMDN)
      ENDIF       
      RETURN 
*----
*  Formats
*  WARNING
*----
 7000 FORMAT(' ***** WARNING IN ',A6,' *****')
 7010 FORMAT(' Local parameters for channel ',I5,' bundle ',I5,
     >       ' not available for ',A6,' state'/
     >       ' Initialize to 0.0')
      END