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
399
400
401
402
403
404
|
*DECK D2PGEN
SUBROUTINE D2PGEN( IPINP, IPDAT, STAVEC, JOBTIT, FILNAM, DER,
> VERS, COM, JOBOPT, IUPS, FA_K, SFAC,
> BFAC, DEB, XESM, FC1 , FC2, FC3,
> FC4, XSC, IPRINT )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Create the GENPMAXS input file GENPMAXS.inp at phase 1
* WARNING: 04/2014: the format of this file respects the GENPMAXS format
* (it can't be changed)
* The information is recovered from the input file (.x2m) and stored in
* the INFO DATA block. The user can change any values in the input file
*
*Author(s):
* J. Taforeau
*
*Parameters: input
* IPINP file unit of GENPMAXS.inp file
* IPDAT address of info data block
* VERS version of PARCS to be used
* SFAC the scattering cross section factor
* BFAC the multiplier for betas
* DEB FLAG to indicate the first call to the D2PGEN subroutine
* FA_K assembly type
* =0 reflector
* =1 assembly
* IUPS treatment for upscattering
* =0 keep up scatter XS
* =1 remove up scatter XS, modify down scatter with DRAGON
* spectrum (not available in this version)
* =2 remove up scatter XS, modify down scatter with infinite
* medium spectrum
* STAVEC various parameters associated with the IPDAT structure
* FILNAM name of IPINP
* JOBTIT title of in header of PMAXS file
* COM comment to be printed in PMAXS file
* DER partials derivative (T) or row cross section (F) to be stored
* in PMAXS
* JOBOPT array of flag to indicate the content option in the HELIOS
* like file and PMAXS
* XESM option for comparing k-inf in GenPMAX (1: using Pm/Sm data;
* 2: using I/Xe data; 3: using I/Xe/Pm/Sm data)
*
*Parameters:
* FC1
* FC2
* FC3
* FC4
* XSC
* IPRINT
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPDAT
INTEGER IPINP,STAVEC(40),FA_K,IUPS,DEB,XESM
REAL SFAC,BFAC,VERS
CHARACTER FILNAM*12,COM*40
CHARACTER*16 JOBTIT
CHARACTER*1 DER
REAL FC1(5)
REAL FC2(8)
REAL FC3(7)
REAL FC4(3)
REAL XSC(3)
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) IPTH,KPTH
! INDEX AND FLAG EXISTENCE OF : TEMPERATURE OF FUEL AND MODERATO
INTEGER ITCOM, ITMOD,TMOD, TCOM
! NUMBER OF STATES VARIABLES, BURNUP EXEPTED
INTEGER NVAR
! NUMBER OF STATES VARIABLES
INTEGER STVARN
! IF FLAG=1, END OF A BRANCH CALCULATION
INTEGER FLAG_PRINT, FLAG
! NUMBER OF BRANCH CONTAINED IN THE FINAL PMAXS FILE
INTEGER NBR
! INDEX OF THE CURRENT BRANCH AND NUMBER OF BURNUP POINTS
INTEGER BR_IT, NBU
INTEGER CRDINF(STAVEC(6)),STAIDX(STAVEC(2))
INTEGER IB,PK,GRID,NCRD,NDEL,NLOC,ST
! DATA SOURCE INFORMATION (CF GENPMAXS MANUAL)
REAL DATSRC(5),LOCYLD(5),THCK
REAL STATE(STAVEC(2)),HISTORY(STAVEC(2)-1), BU(STAVEC(4))
CHARACTER(len=12) STATE_VAR(STAVEC(2))
CHARACTER(len=4) STAVAR(STAVEC(2))
INTEGER PKIDX(STAVEC(2))
CHARACTER*1 JOBOPT(16)
CHARACTER*4 BR
CHARACTER*3 ADF_T
CHARACTER*12,DIMENSION(6) :: PKNAM
DATA PKNAM/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
LOGICAL LFLAG(6)
LOGICAL :: LYLD=.FALSE.
CHARACTER*3 YLDOPT
! INITIALIZATION OF ARRAYS
DATSRC(1)= 2.0
DATSRC(2)= 1.0
DATSRC(3)= FA_K
DATSRC(4)= SFAC
DATSRC(5)= BFAC
NGP=STAVEC(1)
NBU=STAVEC(4)
STVARN=STAVEC(2)
NVAR=STVARN-1
NCRD=STAVEC(6)
NDEL=STAVEC(7)
!RECOVER INFORMATION FROM INFO DATA block
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
IF (JOBOPT(9).EQ. 'T') LYLD = .TRUE.
IF (LYLD) THEN
CALL LCMGTC(IPDAT,'YLD_OPT',3,YLDOPT)
CALL LCMGET(IPDAT,'YLD_LOC',LOCYLD)
ENDIF
CALL LCMGTC(IPDAT,'STATE_VAR',12,STVARN,STATE_VAR)
CALL LCMGET(IPDAT,'PKIDX',PKIDX)
DO PK=1, 6
IPTH=LCMGID(IPDAT,'PKEY_INFO')
KPTH=LCMDIL(IPTH,PK)
CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
IF (PK == 1 .OR. PK==6)THEN
CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
ELSE
IF(LFLAG(PK)) CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
ENDIF
ENDDO
IF(FA_K==1) THEN
GRID=STAVEC(5)
ELSE
GRID = 2 ! NO XE/SM FOR REFLECTOR CASE
ENDIF
ITCOM=0
ITMOD=0
TCOM=0
TMOD=0
DO IST=1, STVARN
IF(STATE_VAR(IST)==PKNAM(1)) STAVAR(IST)='CR '
IF(STATE_VAR(IST)==PKNAM(2)) STAVAR(IST)='DC '
IF(STATE_VAR(IST)==PKNAM(3)) STAVAR(IST)='PC '
IF(STATE_VAR(IST)==PKNAM(6)) STAVAR(IST)='BU '
IF(STATE_VAR(IST)==PKNAM(4)) THEN
ITCOM=IST
TCOM=1
STAVAR(IST)='TF '
ENDIF
IF(STATE_VAR(IST)==PKNAM(5)) THEN
ITMOD=IST
TMOD = 1
STAVAR(IST)='TC '
ENDIF
ENDDO
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
CALL LCMPTC(IPDAT,'IDEVAR',4,STVARN,STAVAR)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
IF(DEB.LE.0) THEN
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
CALL LCMPUT(IPDAT,'FLAG',1,1,DEB)
FLAG=DEB
CALL LCMSIX(IPDAT,' ',0)
CALL LCMGET(IPDAT,'BARR_INFO',CRDINF)
CALL D2PREF( IPDAT, STVARN, CRDINF, NCRD, GRID, PKIDX,
1 PKNAM, IPRINT )
IF (LYLD.and. (YLDOPT.EQ.'MAN')) THEN
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMGET(IPDAT,'STATE',STATE)
NLOC=0
ST=0
DO I=1,5
IF (LOCYLD(I).NE. -1) THEN
NLOC=NLOC+1
IF (LFLAG(I)) THEN
ST=ST+1
STATE(I)=LOCYLD(I)
STATE_VAR(I)=PKNAM(I)
ELSE IF (I.EQ.1) THEN
ST=ST+1
STATE_VAR(I)=PKNAM(I)
ENDIF
ENDIF
ENDDO
IF ((NLOC.NE.ST).OR.(NLOC.NE.NVAR)) THEN
WRITE(6,*) '@D2PGEN : INCORRECT NUMBER OF STATE PARAMETERS',
> ' SET IN "YLD MAN" CARD : ',NLOC
CALL XABORT('=> PLEASE FOLLOW THE SAP/MCO OBJECT CONTENT.')
ENDIF
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMPUT(IPDAT,'STATE',STVARN,2,STATE)
ENDIF
ELSE
CALL LCMGET(IPDAT,'FLAG',FLAG)
ENDIF
IF(FLAG .LE. 0) THEN
!FIRST CALL TO D2PGEN SUBROUTINE
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
! CHECK THE JOB_OPT VECTOR
! LDED : DIRECT ENERGY DEPOSITION FRACTION NOT IMPLEMENTED
IF(JOBOPT(3)=='T') JOBOPT(3)='F'
! LJ1F : J1 FACTOR FOR MINIMAL CRITICAL POWER RATIO
IF(JOBOPT(6)=='T') JOBOPT(6)='F'
! LCHD : DELAY NEUTRON FISSION SPECTRUM NOT IMPLEMENTED
! IF(JOBOPT(8)=='T') JOBOPT(8)='F'
! LBET : BETA NOT IMPLEMENTED
IF((JOBOPT(12)=='T') .and. NDEL > 6) THEN
JOBOPT(12)='F'
WRITE(6,*) "@D2PGEN: WARNING "
WRITE(6,*) "NUMBER OF DELAYED NEUTRON GROUPS > 6 "
! HELIOS FORMAT ACCEPTS ONLY NDEL =6
WRITE(6,*) "lbet (JOBOPT(12)) FLAG FORCED TO FALSE "
ENDIF
! LDEC : DECAY HEAT DATA NOT IMPLEMENTED
IF(JOBOPT(14)=='T') JOBOPT(14)='F'
IF((JOBOPT(13)=='T') .and. NDEL > 6) THEN
JOBOPT(13)='F'
WRITE(6,*) "@D2PGEN: WARNING "
WRITE(6,*) "NUMBER OF DELAYED NEUTRON GROUPS > 6 "
! HELIOS FORMAT ACCEPTS ONLY NDEL =6
WRITE(6,*) "lamb (JOBOPT(13)) FLAG FORCED TO FALSE "
ENDIF
! RECOVER INFORMATION FROM GENPMAXS_INP
CALL LCMPTC(IPDAT,'JOB_TIT',16,JOBTIT)
CALL LCMPTC(IPDAT,'DERIVATIVE',1,DER)
CALL LCMPTC(IPDAT,'JOB_OPT',1,16,JOBOPT(:16))
CALL LCMPUT(IPDAT,'IUPS',1,1,IUPS)
CALL LCMPUT(IPDAT,'XESMOPT',1,1,XESM)
CALL LCMPUT(IPDAT,'DAT_SRC',5,2,DATSRC)
CALL LCMPTC(IPDAT,'COMMENT',40,COM)
CALL LCMPUT(IPDAT,'VERSION',1,2,VERS)
CALL LCMPTC(IPDAT,'FILE_NAME',12,FILNAM)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'HELIOS_HEAD',1)
CALL LCMPUT(IPDAT,'FILE_CONT_1',2,2,FC1(4:5))
CALL LCMPUT(IPDAT,'FILE_CONT_2',8,2,FC2)
CALL LCMPUT(IPDAT,'FILE_CONT_3',7,2,FC3)
CALL LCMPUT(IPDAT,'FILE_CONT_4',3,2,FC4)
CALL LCMPUT(IPDAT,'XS_CONT',3,2,XSC)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
! RECOVER HISTORY STATE AND number of branches
CALL LCMGET(IPDAT,'HST_STATE',HISTORY)
CALL LCMGET(IPDAT,'BRANCH_NB',NBR)
! WRITING JOBTIT CARD
IF(IPRINT > 2) THEN
WRITE(6,*)
WRITE(6,*) "******* INFORMATION FOR GENPMAXS INPUT *********"
WRITE(6,*)
WRITE(6,*) "JOB_TIT CARD : JOB_TIT,DERIVATIVE,",
1 " VERSION, COMMENT"
WRITE(6,*) "VALUES :",JOBTIT,DER, VERS, COM
WRITE(6,*)
WRITE(6,*) "JOB_OPT CARD : ad,xe,de,j1,ch,Xd,iv,dt,yl,cd,gf,",
1 " be,lb,dc,ups"
WRITE(6,'(A,14(A,1X))') "VALUES :",JOBOPT(1:14)
WRITE(6,*)
WRITE(6,*) "DAT_SRC CARD : SRC_KIND, NFILE, FA_KIND, SFAC,",
1 " BFAC"
WRITE(6,*) "VALUES :",INT(DATSRC)
WRITE(6,*)
WRITE(6,*) "STAVAR CARD :"
WRITE(6,*) "NUMBER :",STVARN
WRITE(6,*) "VALUES :",STAVAR(1:STVARN)
WRITE(6,*)
WRITE(6,*) "HISTORY CARD (IN GENPMAXS FORMALISM):"
WRITE(6,*) "VALUES OF STATES VARIABLES :",HISTORY(1:NVAR)
WRITE(6,*)
WRITE(6,*) "BRANCH CARD :"
WRITE(6,*) "NUMBER OF BRANCHES : ",NBR
WRITE(6,*)
ENDIF
ELSE IF(FLAG == 1) THEN
CALL LCMSIX(IPDAT,' ',0)
CALL LCMGET(IPDAT,'BARR_INFO',CRDINF)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMGET(IPDAT,'STATE',STATE)
CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX)
CALL LCMGET(IPDAT,'PRINT',FLAG_PRINT)
CALL LCMGTC(IPDAT,'BRANCH',4,BR)
CALL LCMGET(IPDAT,'BRANCH_IT',BR_IT)
! REORG BARR INFORMATION
DO IB=1 ,NCRD
IF(STATE(1)==CRDINF(IB)) THEN
STATE(1)=IB-1
EXIT
ENDIF
ENDDO
! TEMPERATURE CONVERSION
IF (STAVEC(19).EQ.0) THEN
IF(TCOM==1) STATE(ITCOM)=STATE(ITCOM)+273.15 ! convert C to K
IF(TMOD==1) STATE(ITMOD)=STATE(ITMOD)+273.15
ENDIF
! CONTINUE WRITING BRANCH CARD
IF(FLAG_PRINT==1) THEN
WRITE (IPINP,'(A,A,I4.4,3X,3(F11.5,1X,F11.5,1X))')
1 'HIST',BR(1:2),BR_IT,(STATE(I), I=1,NVAR)
ENDIF
IF(IPRINT > 2) THEN
WRITE(6,*)
WRITE(6,*) "*CONTINUE WRITING BRANCH CARD IN GENPMAXS INPUT*"
WRITE(6,*)
WRITE(6,*) "BRANCH TYPE : ",BR
WRITE(6,*) "BRANCH INDEX : ",BR_IT
WRITE(6,*) "BRANCH STATE VALUES : ",STATE(1:NVAR)
WRITE(6,*) "BRANCH STATE INDEX : ",STAIDX(1:NVAR)
WRITE(6,*)
ENDIF
ELSE IF(FLAG == 2) THEN
! RECOVER INFORMATION FROM INFO
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
CALL LCMGET(IPDAT,'BURN',BU)
IF(JOBOPT(1)=='T') THEN
CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
IF (ADF_T.EQ.'GEN') CALL LCMGET(IPDAT,'THCK',THCK)
ENDIF
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMGET(IPDAT,'BRANCH_NB',NBR)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
CALL LCMGTC(IPDAT,'FILE_NAME',12,FILNAM)
CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
! WRITING BURNUP CARD
WRITE (IPINP,'(A)') '%BURNUP'
WRITE (IPINP,'(I1,/,A,3X,I2)') 1, 'set1',NBU
WRITE (IPINP,'(5(3X,F8.3),/)') (BU(I)/1000, I=1,NBU)
WRITE (IPINP,'(A,1X,I4,A,I1)') 'HIST01',NBR,'*',1
IF ((INT(DATSRC(3)).EQ.0).AND.(JOBOPT(1)=='T')
> .AND.(ADF_T.EQ.'GEN'))THEN
WRITE (IPINP,'(A)')'%ADF_1D'
WRITE (IPINP,'(A)')'ANM 0 1'
WRITE (IPINP,'(F8.5)')THCK
ENDIF
! WRITING HEL_FMT CARD
WRITE (IPINP,'(A)') '%HEL_FMT'
WRITE (IPINP,'(I1,/,I1,1X,I2,1X,I2,1X,I1)') 1,1,24,12,8
! WRITING FIL_CNT CARD
WRITE (IPINP,'(A)') '%FIL_CNT'
WRITE (IPINP,'(I1,3X,A,3X,I4,3X,I1)') 1,FILNAM,NBR,1
DO IB=1,NBR
WRITE (IPINP,'(I4,1X,I1,1X,I4,1X,I1,1X,I2)') IB,1,IB,1,NBU
ENDDO
! WRITING JOB_END CARD
WRITE (IPINP,'(A)') '%JOB_END'
IF(IPRINT > 2) THEN
WRITE(6,*)
WRITE(6,*) "***** END OF EDITING THE GENPMAXS INPUT ******"
WRITE(6,*)
WRITE(6,*) "BURNUP CARD : "
WRITE(6,*) "VALUES OF BURNUP POINTS :",BU/1000
WRITE(6,*)
WRITE(6,*) "HEL_FMT CARD : NFMT, Index, LABEL, WIDTH, COLUMN"
WRITE(6,*) "VALUES (FIXED) :",1,4,24,12,8
WRITE(6,*)
WRITE(6,*) "EDIT FIL_CNT CARD "
WRITE(6,*)
ENDIF
ENDIF
CALL LCMSIX(IPDAT,' ',0)
END
|
