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
|
SUBROUTINE D2PHEL ( IPHEL, IPDAT, IPMIC , IPINP, STAVEC,
> JOBOPT, IPRINT )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Store the header of HELIOS.dra file - (independant data compared with
* branching calculation) at phase 1
* WARNING: 04/2014 : the format of this file respect the HELIOS format
* (it cannot 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
* IPHEL file unit of HELIOS like file
* IPDAT adress of info data block
* STAVEC various parameters associated with the IPDAT structure
* FC1 FILE_CONT_1 recovered from D2P: input
* FC2 FILE_CONT_2 recovered from D2P: input
* FC3 FILE_CONT_3 recovered from D2P: input
* FC4 FILE_CONT_4 recovered from D2P: input
* XSC XS_CONT recovered from D2P: input
* IPRINT control the printing on screen
*
*Parameters:
* IPMIC
* IPINP
* JOBOPT
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPDAT,IPMIC
INTEGER IPHEL
INTEGER STAVEC(40)
! FILE_CONT DATA BLOC ( CF D2P: DOCUMENTATION)
REAL FC1(2)
REAL FC2(8)
REAL FC3(7)
REAL FC4(3)
REAL XSC(3)
REAL DATSRC(5)
*----
* LOCAL VARIABLES
*----
INTEGER NBU,FA_K
CHARACTER*16 JOBTIT
CHARACTER*12 FILNAM
CHARACTER*1 DER
CHARACTER*40 COM
CHARACTER*1 JOBOPT(16)
REAL HISTORY(STAVEC(2)-1)
CHARACTER*4 STAVAR(STAVEC(2))
INTEGER IUPS,XESM
REAL VERS
NBU=STAVEC(4)
NPAR=STAVEC(2)
NVAR=NPAR-1
! RECOVER INFORMATION FROM INFO/HELIOS_HEAD DATA BLOCK
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
CALL LCMGTC(IPDAT,'IDEVAR',4,NPAR,STAVAR)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
CALL LCMGTC(IPDAT,'JOB_TIT',16,JOBTIT)
CALL LCMGTC(IPDAT,'DERIVATIVE',1,DER)
CALL LCMGET(IPDAT,'IUPS',IUPS)
CALL LCMGET(IPDAT,'XESMOPT',XESM)
CALL LCMGTC(IPDAT,'COMMENT',40,COM)
CALL LCMGET(IPDAT,'VERSION',VERS)
CALL LCMGTC(IPDAT,'FILE_NAME',12,FILNAM)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'HELIOS_HEAD',1)
CALL LCMGET(IPDAT,'FILE_CONT_1',FC1)
CALL LCMGET(IPDAT,'FILE_CONT_2',FC2)
CALL LCMGET(IPDAT,'FILE_CONT_3',FC3)
CALL LCMGET(IPDAT,'FILE_CONT_4',FC4)
CALL LCMGET(IPDAT,'XS_CONT',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)
IF (IUPS.EQ.2) IUPS=0
FA_K=INT(DATSRC(3))
IF ((STAVEC(21).EQ.1) .and. (JOBOPT(1).EQ.'T') )THEN
JOBOPT(1)='F'
ENDIF
IF (STAVEC(19).EQ.0) THEN
DO I=1,NVAR
IF (STAVAR(I).EQ.'TF ') THEN
HISTORY(I)=HISTORY(I)+273.15
ENDIF
IF (STAVAR(I).EQ.'TC ') THEN
HISTORY(I)=HISTORY(I)+273.15
ENDIF
ENDDO
ENDIF
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMPUT(IPDAT,'HST_STATE',NVAR,2,HISTORY)
! WRITING JOBTIT CARD
WRITE (IPINP,*) '%JOB_TIT'
WRITE (IPINP,'(A,A,A,1X,A,1X,F3.1,1X,A,A,A)')
1'"',JOBTIT,'"',DER, VERS, '"',COM,'"'
! WRITING JOB_OPT CARD
WRITE (IPINP,*) '%JOB_OPT'
WRITE (IPINP,'(14(A,1X),2(I1,1X))',advance="no")
1 JOBOPT(1:14),IUPS,XESM
WRITE (IPINP,'(/A)')
1'!ad,xe,de,j1,ch,Xd,iv,dt,yl,cd,gf,be,lb,dc,ups'
! WRITING DAT_SRC CARD
WRITE (IPINP,*) '%DAT_SRC'
WRITE(IPINP,'(I2,1X,I2,1X,I2,1X,F3.1,1X,F3.1)')INT(DATSRC(1)),
1INT(DATSRC(2)),INT(DATSRC(3)),DATSRC(4),DATSRC(5)
! WRITING STA_VAR CARD
WRITE (IPINP,*) '%STA_VAR'
WRITE (IPINP,'(I2/,3(A,1X,A))') NVAR,(STAVAR(I), I=1,NVAR)
! WRITING HISTORY CARD
! CONCERN THE CONTROL ROD COMPOSITION
IF(HISTORY(1)==0) THEN
HISTORY(1)=1
ELSE IF(HISTORY(1)==1) THEN
HISTORY(1)=0
ELSE IF(HISTORY(1)==2) THEN
HISTORY(1)=2
ENDIF
WRITE (IPINP,*) '%HISTORY'
WRITE (IPINP,'(I1,1X,I1,/,A,1X,3(F11.5,1X,F11.5,1X))') 1,1,
1'HIST01',(HISTORY(I), I=1,NVAR)
! WRITING BRANCH CARD
WRITE (IPINP,*) '%BRANCH'
WRITE (IPINP,'(I4,1X,I1)') NBR, 1
! WRITE FILE_CONT DATA in HELIOS.dra file
IF(IPRINT > 0) WRITE(6,*) "STEP 1 : EDIT THE HEADER "
CALL SET_INFO(IPHEL)
IF(IPRINT > 0) WRITE(6,*) "STEP 2 : EDIT THE CONT1 BLOCK "
IF (FA_K.EQ.0) THEN
FC1(1)=0.
ELSE
IF (FC1(1).EQ.0.) THEN
CALL LCMSIX(IPMIC,'',0)
CALL LCMSIX(IPMIC,'MACROLIB',1)
CALL LCMLEN(IPMIC,'MASL',ILONG,ITYLCM)
IF (ILONG.GT.1) THEN
CALL XABORT("@D2PHEL: MORE THAN 1 METAL DENS. IN THE MICROLIB")
ELSE IF (ILONG.EQ.0) THEN
WRITE(6,*)"@D2PHEL: RECORD MASL NOT FOUND IN MICROLIB"
WRITE(6,*)"=> PLEASE USE THE FILE_CONT_1 CARD IN D2P:"
CALL XABORT(" OR USE THE 'REFLECTOR' KEYWORD")
ELSE
CALL LCMGET(IPMIC,'MASL',FC1(1))
ENDIF
ELSE IF (FC1(1).LE.0.) THEN
CALL XABORT('@D2PHEL: NEGATIVE VALUE FOR HEAVY METAL DENSITY')
ENDIF
ENDIF
CALL LCMPUT(IPDAT,'FILE_CONT_1',2,2,FC1)
CALL SET_CONT1(IPHEL,STAVEC,FC1,IPRINT)
! IF(IPRINT > 0) WRITE(6,*) "STEP 3 : EDIT THE CONT2 BLOCK "
! CALL SET_CONT2(IPHEL,FC2,NGP,IPRINT)
IF(IPRINT > 0) WRITE(6,*) "STEP 4 : EDIT THE CONT3 BLOCK "
CALL SET_CONT3(IPHEL,FC3,IPRINT)
IF(IPRINT > 0) WRITE(6,*) "STEP 5 : EDIT THE CONT4 BLOCK "
CALL SET_CONT4(IPHEL,FC4,IPRINT)
! MOVE TO GENPMAXS_INP DIRECTORY
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
IF ((STAVEC(21).EQ.1) .and. (JOBOPT(1).EQ.'F') )THEN
JOBOPT(1)='T'
ENDIF
END
SUBROUTINE SET_CONT1(IPHEL,STAVEC,FILE_CONT_1,IPRINT)
INTEGER STAVEC(40)
REAL FILE_CONT_1(2)
WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA'
WRITE(IPHEL,*) 'Labels Array : KINF'
WRITE(IPHEL,*) 'List Title(s) 1) ==========================='
WRITE(IPHEL,*) ' 2) %FILE_CONT 1'
WRITE(IPHEL,*) ' 3) ==========================='
WRITE(IPHEL,*) ' 4) Meaning : NGROUP, NCOLS, NR'
1 //'OWS, PART,'
WRITE(IPHEL,*) ' HM Density, Bypass Density '
CALL SET_RIEGO(IPHEL)
WRITE(IPHEL,120) 'NGROUP','NCOLS','NROWS','PART',
1 'DenHM','DenByp'
WRITE(IPHEL,125) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.',
1 '.-.-E-.-.','1-.-E-.-.','.-.-E-.-.'
WRITE(IPHEL,130) ' 1 HST 1 HST : 0',STAVEC(1),
1 STAVEC(8),STAVEC(9), STAVEC(10),
2 FILE_CONT_1(1),FILE_CONT_1(2)
WRITE(IPHEL,'()')
IF(IPRINT > 1) THEN
WRITE(6,*)
WRITE(6,*) "CONTENT : NGROUP, NCOLS, NROWS, PART,",
1 " HM Density, Bypass Density "
WRITE(6,*) "VALUES :",STAVEC(1),STAVEC(8:10),FILE_CONT_1
WRITE(6,*)
ENDIF
120 FORMAT(27X,A,9X,A,9X,A,10X,A,9X,A,8X,A)
125 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A)
130 FORMAT(A,10X,I2,10X,I2,10X,I2,10X,I2,5X,F7.5,5X,F7.5)
END
SUBROUTINE SET_CONT2(IPHEL,FILE_CONT_2,NGROUP,IPRINT)
INTEGER NGROUP
CHARACTER*9 LABEL
REAL FILE_CONT_2(NGROUP)
WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA'
WRITE(IPHEL,*) 'Labels Array : KINF'
WRITE(IPHEL,*) 'List Title(s) 1) ==========================='
WRITE(IPHEL,*) ' 2) %FILE_CONT 2'
WRITE(IPHEL,*) ' 3) ==========================='
WRITE(IPHEL,*) ' 4)Meaning : Lower Energy of Neu'
1 //'tron Groups'
CALL SET_RIEGO(IPHEL)
IF(NGROUP .EQ. 8) THEN
WRITE(IPHEL,220) 'EMIN','EMIN'
WRITE(IPHEL,225) 'Label E'
DO I=1, NGROUP
WRITE(LABEL,'(A,I1,A)')".-.-E-",I,"-."
PRINT*,"LABEL",LABEL
WRITE(IPHEL,'(A9,5X)',advance='no')LABEL
ENDDO
WRITE(IPHEL,230) ' 1 HST 1 HST : 0',FILE_CONT_2(1),
1 FILE_CONT_2(2)
ELSE
CALL XABORT ("@D2PHEL: NUMBER OF ENERGY GROUPS MUST BE 2")
ENDIF
IF(IPRINT > 1) THEN
WRITE(6,*)
WRITE(6,*) "CONTENT : Lower Energy of Neutron Groups"
WRITE(6,*) "VALUES :",FILE_CONT_2 (1:NGROUP)
WRITE(6,*)
ENDIF
220 FORMAT(32X,A,10X,A)
225 FORMAT(6X,A,17X)
230 FORMAT(A,ES12.5E2,ES12.5E2)
END
SUBROUTINE SET_CONT3(IPHEL,FILE_CONT_3,IPRINT)
REAL FILE_CONT_3(7)
WRITE(IPHEL,'()')
WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA'
WRITE(IPHEL,*) 'Labels Array : KINF'
WRITE(IPHEL,*) 'List Title(s) 1) ==========================='
WRITE(IPHEL,*) ' 2) %FILE_CONT 3'
WRITE(IPHEL,*) ' 3) ==========================='
WRITE(IPHEL,*) ' 4)Meaning : Regions Volume'
CALL SET_RIEGO(IPHEL)
WRITE(IPHEL,320) 'VCool','VWatR','VModr','VCnRd','VFuel',
1 'VClad','VChan'
WRITE(IPHEL,310) 'Label E','1-.-E-.-.','.-.-E-.-.','1-.-E-.-.',
1 '1-.-E-.-.','1-.-E-.-.','1-.-E-.-.','1-.-E-.-.'
WRITE(IPHEL,390) ' 1 HST 1 HST : 0',FILE_CONT_3(1),
1 FILE_CONT_3(2),FILE_CONT_3(3),FILE_CONT_3(4),FILE_CONT_3(5),
2 FILE_CONT_3(6),FILE_CONT_3(7)
IF(IPRINT > 1) THEN
WRITE(6,*)
WRITE(6,*) "CONTENT : VCool, VWatR, VModr, VCnRd, VFuel,",
1 " VClad, VChan"
WRITE(6,*) "VALUES :",FILE_CONT_3
WRITE(6,*)
ENDIF
310 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A,3X,A)
320 FORMAT(27X,A,2X,A,9X,A,9X,A,9X,A,9X,A,9X,A,9X,A)
390 FORMAT(A,ES12.5E2,ES12.5E2,ES12.5E2,ES12.5E2,
1 ES12.5E2,ES12.5E2,ES12.5E2,ES12.5E2)
END
SUBROUTINE SET_CONT4(IPHEL,FILE_CONT_4,IPRINT)
REAL FILE_CONT_4(3)
WRITE(IPHEL,'()')
WRITE(IPHEL,*) 'List name : PMAX_FILE_DATA'
WRITE(IPHEL,*) 'Labels Array : KINF'
WRITE(IPHEL,*) 'List Title(s) 1) ==========================='
WRITE(IPHEL,*) ' 2) %FILE_CONT 4'
WRITE(IPHEL,*) ' 3) ==========================='
WRITE(IPHEL,*) ' 4) Cell Pitch and X,Y Pos of F'
1 //'irst Cell'
CALL SET_RIEGO(IPHEL)
WRITE(IPHEL,320) 'PITCH','XBE','YBE'
WRITE(IPHEL,410) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.'
WRITE(IPHEL,390) ' 1 HST 1 HST : 0',FILE_CONT_4(1),
1 FILE_CONT_4(2),FILE_CONT_4(3)
IF(IPRINT > 1) THEN
WRITE(6,*)
WRITE(6,*) "CONTENT : PITCH ,XBE , YBE"
WRITE(6,*) "VALUES :", FILE_CONT_4
WRITE(6,*)
ENDIF
320 FORMAT(24X,A,11X,A,11X,A)
390 FORMAT(A,ES12.5E2,ES12.5E2,ES12.5E2)
410 FORMAT(6X,A,12X,A,5X,A,5X,A)
END
SUBROUTINE SET_INFO(IPHEL)
WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
WRITE(IPHEL,*) 'Pre-processing for PMAXS Generation'
DO I=1, 18
WRITE(IPHEL,*) '*'
ENDDO
WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
WRITE(IPHEL,*) 'DRAGON CALCULATION BY J.TAFOREAU'
WRITE(IPHEL,*) 'HELIOS Cases Used:'
WRITE(IPHEL,'()')
WRITE(IPHEL,*) ' 1) IMP-operator name : kkk'
WRITE(IPHEL,*) ' DRAGON case : kkk'
WRITE(IPHEL,*) ' Title(s) 1 : kkk'
WRITE(IPHEL,'()')
END
SUBROUTINE SET_RIEGO(IPDRA)
WRITE(IPDRA,'()')
WRITE(IPDRA,*) '(R) Area/Face names : unlabeled'
WRITE(IPDRA,*) '(I) Isotope Identifiers : unlabeled'
WRITE(IPDRA,*) '(E) Path (STATE) idents : * '
WRITE(IPDRA,*) '(G) Group name : unlabeled'
WRITE(IPDRA,*) '(O) Originating Group : unlabeled'
WRITE(IPDRA,'()')
END
|
