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
|
*DECK D2PXS
SUBROUTINE D2PXS (IPDAT,IPMIC,IPSAP,STAVEC,SIGNAT,MIXDIR,
> JOBOPT,IPRINT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover cross sections from a microlib object and write cross
* sections for one branch at a fixed burnup point in the INFO data
* block.
*
*Author(s):
* J. Taforeau
*
*Parameters: input
* IPDAT address of info data block
* IPSAP address of the saphyb object
* IPMIC address of the microlib object
* STAVEC various parameters associated with the IPDAT structure
* SIGNAT signature of the object containing cross sections
* MIXDIR directory that contains homogeneous mixture information
* IPRINT control the printing on screen
*
*Parameters:
* JOBOPT
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPDAT,IPMIC,IPSAP
INTEGER STAVEC(40),IPRINT
CHARACTER*12 SIGNAT,MIXDIR
*----
* LOCAL VARIABLES
*----
! INDEX OF CURRENT VALUE FOR EACH STATE VARIABLES
PARAMETER(NSTATE=40)
INTEGER STAIDX (STAVEC(2)),ISTATE(NSTATE)
INTEGER DIMSAP(50)
INTEGER ITBRA,NSF,ITR
INTEGER ::NREA = 0
INTEGER :: NISO = 0
INTEGER ::NMIL = 0
INTEGER ::NBISO = 0
INTEGER ::NANI = 0
INTEGER ::NFISS = 0
INTEGER :: NADD = 0
INTEGER :: NBMIX = 0
INTEGER :: NMAC = 0
INTEGER :: NADRX = 0
INTEGER :: NPAR = 0
INTEGER :: NDEL = 0
INTEGER :: ISPH = 0
! INDICATES THE END OF A BRANCH CALCULATION (REW=1), AND A
! DEFAULT MESHING (GRID)
INTEGER REW,GRID
! NUMBER OF STATES VARIABLES
INTEGER NVAR
! NUMBER OF BURNUP POINTS
INTEGER NBU,NGP
INTEGER :: NADF = 1
INTEGER :: NCDF = 1
INTEGER :: NGFF = 1
INTEGER :: NPIN = 1
INTEGER :: NTYPE = 1
INTEGER FLAG
INTEGER ICOR
REAL STATE(STAVEC(2)),BURN(STAVEC(4)),REFSTA(STAVEC(2)-1)
! DATSRC BLOCK OF INFO/GENPMAXS DIRECTORY
REAL DATSRC(5),FLUX(STAVEC(1))
! STATE VARIABLE NAMES
CHARACTER(len=12) STAVAR(STAVEC(2))
CHARACTER JOBOPT(16)
CHARACTER*4 BRANCH
CHARACTER*3 ADF_T,CDF_T,GFF_T
LOGICAL LABS(3),SCAT
LOGICAL :: LADF = .FALSE.
LOGICAL :: LCDF = .FALSE.
LOGICAL :: LGFF = .FALSE.
LOGICAL :: LXES = .FALSE.
LOGICAL :: LDET = .FALSE.
LOGICAL :: LTH = .FALSE.
LOGICAL :: LCOR = .FALSE.
! INITIALIZATION OF PARAMETERS
NVAR=STAVEC(2)
NBU=STAVEC(4)
GRID=STAVEC(5)
NGP=STAVEC(1)
NSF=STAVEC(11)
ICOR=STAVEC(22)
! RECOVER INFORMATION FROM INFO date block
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
CALL LCMGET(IPDAT,'FLAG',FLAG)
CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
IF (ICOR>0) LCOR=.TRUE.
IF(JOBOPT(1)=='T') THEN
CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
LADF = .TRUE.
IF((ADF_T.EQ.'SEL').OR.(ADF_T.EQ.'GET')) THEN
STAVEC(13)=NSF
STAVEC(14)=1
ENDIF
IF((ADF_T.EQ. 'DRA').OR.(ADF_T.EQ. 'GEN'))THEN
STAVEC(13)=1
CALL LCMSIX(IPMIC,' ',0)
CALL LCMSIX(IPMIC,'MACROLIB',1)
CALL LCMSIX(IPMIC,'ADF',1)
CALL LCMGET(IPMIC,'NTYPE',STAVEC(14))
ENDIF
NADF=STAVEC(13)
NTYPE=STAVEC(14)
ENDIF
IF(JOBOPT(2)=='T') LXES = .TRUE.
IF(JOBOPT(8)=='T') LDET = .TRUE.
IF((JOBOPT(5)=='T').OR.(JOBOPT(7)=='T').OR.
> (JOBOPT(9)=='T').OR.(JOBOPT(13)=='T')) THEN
LTH =.TRUE.
ENDIF
IF(JOBOPT(10)=='T') THEN
CALL LCMGTC(IPDAT,'CDF_TYPE',3,CDF_T)
LCDF = .TRUE.
IF(CDF_T.EQ. 'DRA')THEN
CALL LCMSIX(IPMIC,' ',0)
CALL LCMSIX(IPMIC,'MACROLIB',1)
CALL LCMSIX(IPMIC,'ADF',1)
CALL LCMGET(IPMIC,'NTYPE',STAVEC(14))
ENDIF
NCDF=STAVEC(15)
NTYPE=STAVEC(14)
ENDIF
IF(JOBOPT(11)=='T') THEN
CALL LCMGTC(IPDAT,'GFF_TYPE',3,GFF_T)
LGFF = .TRUE.
NGFF=STAVEC(16)
NPIN=STAVEC(17)
ENDIF
IF(DATSRC(3).NE.0.0) THEN
CALL LCMGET(IPDAT,'LABS',LABS)
CALL LCMGET(IPDAT,'SCAT',SCAT)
ENDIF
CALL LCMGTC(IPDAT,'STATE_VAR',12,NVAR,STAVAR)
CALL LCMGET(IPDAT,'BURN',BURN)
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMGET(IPDAT,'REWIND',REW)
CALL LCMGTC(IPDAT,'BRANCH',4,BRANCH)
CALL LCMGET(IPDAT,'BRANCH_IT',ITBRA)
CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX)
CALL LCMGET(IPDAT,'STATE',STATE)
CALL LCMSIX(IPMIC,' ',0)
CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
NBISO=ISTATE(2) ! NUMBER OF ISOTOPES
NDEL=ISTATE(19) ! NUMBER OF DELAYED NEUTRON GROUPS
IF(NDEL.NE.STAVEC(7)) THEN
WRITE(6,*) "@D2PXS: ERROR IN NUMBER OF DELAYED NEUTRON GROUPS"
WRITE(6,*) "THE NUMBER OF DELAYED NEUTRON GROUPS IN SAP (",
1 STAVEC(7),") IS DIFFERENT FROM MICROLIB (",NDEL,")"
CALL XABORT('@D2PXS: DELAYED NEUTRON DATA ERROR')
ENDIF
ISTATE(:NSTATE)=0
CALL LCMSIX(IPMIC,' ',0)
CALL LCMSIX(IPMIC,'MACROLIB',1)
CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
NBMIX=ISTATE(2) ! NUMBER OF MIXTURESS
NANI=ISTATE(3) ! SCATTERING ANISOTROPY
NADD=ISTATE(5) ! NUMBER OF ADDITIONAL CROSS SECTIONS
NFISS=ISTATE(4) ! NUMBER OF FISSILE ISOTOPES
ITR=ISTATE(6) ! TRANSPORT CORRECTION OTPION
NED=ISTATE(13) ! NUMBER OF P0 ADDITIONAL XS
ISPH=ISTATE(14)
IF(IPRINT > 0) THEN
WRITE(6,*)
WRITE(6,*) "****** BRANCH CHARACTERISTICS ******"
WRITE(6,*) "BRANCH TYPE :",BRANCH
WRITE(6,*) "BRANCH INDEX :",ITBRA
WRITE(6,*) "STATE VARIABLE NAME :",STAVAR
WRITE(6,*) "BRANCH STATE VALUES :",STATE
ENDIF
IF(DATSRC(3)==0.0) THEN
CALL D2PRFL( IPDAT, IPMIC , IPRINT, NBU, NGP, NBMIX,
> NANI, NVAR, STAIDX, LADF, NADF, NTYPE)
ELSE IF(DATSRC(3) == 1.0) THEN
! CASE FOR FUEL CROSS SECTIONS
CALL LCMSIX(IPSAP,' ',0)
DIMSAP(:50)=0
IF (SIGNAT .EQ. 'L_SAPHYB') THEN
CALL LCMGET(IPSAP,'DIMSAP',DIMSAP) ! recover DIMSAP info
NREA=DIMSAP(4) ! NUMBER OF REACTIONS
NISO=DIMSAP(5) ! NUMBER OF PARTICULARIZED ISOTOPES
NMAC=DIMSAP(6) ! NUMBER OF MACROSCOPIC SETS
NMIL=DIMSAP(7) ! NUMBER OF MIXTURES
NPAR=DIMSAP(8) ! NUMBER OF STATE VARIABLE IN SAPHYB
NADRX=DIMSAP(18) ! CONCERN CROSS SECTIONS
! (INCLUDING FLUE AND TIME)
ELSE
CALL LCMSIX(IPSAP,' ',0)
CALL LCMSIX(IPSAP,MIXDIR,1)
CALL LCMGET(IPSAP,'STATE-VECTOR',DIMSAP)
NMIL = DIMSAP(1)
ENDIF
IF(STAVEC(1).NE.ISTATE(1)) THEN
CALL XABORT("@D2PBRA: INCOHERENT NUMBER OF ENERGY GROUPS ")
ENDIF
IF(NMIL.NE.NBMIX) THEN
CALL XABORT("@D2PBRA: DIFFERENT NUMBER OF MIX ")
ENDIF
! RECOVER MACROLIB CROSS SECTIONS FROM SAPHYB
CALL D2PMAC( IPDAT, IPMIC , IPRINT, NBU, NGP, NBMIX,
> NADD, NANI, NVAR, STAIDX, LADF, NADF,
> NTYPE, LCDF, NCDF, LGFF, NGFF, NPIN,
> FLUX )
IF(LTH) THEN
ICOR=STAVEC(22)
! RECOVER THE T/H INVARIANT BLOCK (OPTIONAL IN PMAXS FILES)
CALL D2PTH( IPDAT, IPMIC , IPRINT, NBU, NGP, NBMIX,
> NFISS, NDEL, NVAR, STAIDX,JOBOPT, FLAG)
ENDIF
IF((LXES).OR.(LDET).OR.(LCOR)) THEN
! RECOVER MICROSCOPIC CROSS SECTIONS FROM SAPHYB
CALL D2PMIC ( IPDAT, IPMIC , IPRINT, NGP, NBMIX, NBISO,
> NED, NVAR, STAIDX, LXES, LDET, LCOR,
> FLUX )
ENDIF
IF((GRID<2).and. (SIGNAT .EQ. 'L_SAPHYB')) THEN
! RECOVER THE DIVERS DIRECTORY OF SAPHYB
CALL D2PDIV( IPDAT, IPSAP , IPRINT, NGP, NBU, NVAR,
> GRID, NPAR, NREA, NISO, NMAC, NMIL,
> NANI, NADRX, STAIDX, STATE, STAVAR, NSF,
> LABS, SCAT, LADF )
ENDIF
ENDIF
IF(REW.EQ.NBU) THEN
! REINITIALIZATION OF INDEX
IF (FLAG.EQ.-1) THEN
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMGET(IPDAT,'REF_STATE',REFSTA)
STATE(1:NVAR-1)=REFSTA(:)
FLAG=0
CALL LCMPUT(IPDAT,'FLAG',1,1,FLAG)
ENDIF
STAIDX(NVAR)= 1
REW = 1
STATE(NVAR)=BURN(1)
ELSE
! UPDATE THE INDEX FOR THE CALCULATION OF THE NEXT BRANCH
REW=0
STAIDX(NVAR)= STAIDX(NVAR)+1
REW = STAIDX(NVAR)
STATE(NVAR)=BURN(STAIDX(NVAR))
ENDIF
! STORE NEW VALUES OF BRANCH CALCULATION
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMPUT(IPDAT,'REWIND',1,1,REW)
CALL LCMPUT(IPDAT,'STATE',NVAR,2,STATE)
CALL LCMPUT(IPDAT,'STATE_INDEX',NVAR,1,STAIDX)
END
|
