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
|
*DECK D2PTH
SUBROUTINE D2PTH( IPDAT, IPMIC , IPRINT, NBU, NGP, NBMIX,
> NFISS, NDEL, NVAR, STAIDX,JOBOPT, FLAG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover T/H inveariant data block and store in INFO/TH_DATA/
* WARNING: These data are extracted only if the corresponding flag is
* set to T in the GENPMAXS_INP/JOBOPT vector.
* NB 1 : The data for T/H are recovered from the reference state, the
* branching calculation not includes the TH informations.
* NB 3 : The Helios format cannot recover the CHID (delay neutron
* fission spectrum), it is fixed to default values even if JOBOPT(6)=T.
* NB 4 : The Helios format cannot recover the Decay Heat Data (DBET and
* DLAM in GenPMAXS), it is fixed to default values even if JOBOPT(14)=T.
*
*Author(s):
* J. Taforeau
*
*Parameters: input
* IPDAT address of the INFO data block
* IPMIC address of the MICROLIB object
* IPPRINT control the printing on screen
* NGP number of energy groups
* NBU number of burnup point in IPSAP
* NVAR number of state parameters in INFO data block
* NDEL number of delaued neutron groups
* NBMIX number of mixtrures in IPSAP
* NFISS number of fissile isotopes
* STAIDX index of state variables
* FLAG End of a bran calculation (=-1: branch for yields calculation)
*
*Parameters:
* IPRINT
* JOBOPT
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPDAT,IPMIC
INTEGER IPRINT,NVAR,NBU, NBMIX,NGP
INTEGER NFISS,NDEL
INTEGER STAIDX(NVAR)
INTEGER FLAG
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPMIC,KPMIC,IPTH,KPTH
PARAMETER(NSTATE=40)
INTEGER DSTATE(NSTATE)
INTEGER NDFI,NDFP,MR,MI,MI_REAL,ITYLCM
INTEGER :: I_PF = 0
INTEGER :: iso = 1
REAL YLDI,YLDXe,YLDPm
REAL CHI(NFISS,NGP)
REAL OVERV(NGP),BURN(NBU), STATE(NVAR)
REAL FLX(NGP),NUSIGF_D(NDEL,NGP),NUSIGF(NGP)
REAL BETA_D(NDEL,NFISS),LAMBDA_D(NDEL,NFISS)
REAL NUM(NDEL)
REAL :: DEN = 0.0
CHARACTER*12 ISOTOPES(4)
CHARACTER*1 JOBOPT(16)
CHARACTER*8 NUSID
CHARACTER*3 YLDOPT
REAL YLDFIX(3)
REAL, ALLOCATABLE, DIMENSION(:) :: DEPLETE_ENER,DEPLETE_DECA
REAL, ALLOCATABLE, DIMENSION(:) :: FISSIONYIELD
CHARACTER(len=12),ALLOCATABLE, DIMENSION(:) :: ISOTOPERNAME
CHARACTER(len=12),ALLOCATABLE, DIMENSION(:) :: ISOTOPESDEPL,PF
IF(IPRINT > 1) THEN
WRITE(6,*)
WRITE(6,*) "**************************************************"
WRITE(6,*) "* T/H INVARIANT BLOCK *"
WRITE(6,*) "**************************************************"
WRITE(6,*)
ENDIF
CALL LCMSIX(IPMIC,' ',0)
CALL LCMSIX(IPMIC,'MACROLIB',1)
IF(JOBOPT(13)=='T') CALL LCMGET(IPMIC,'LAMBDA-D',LAMBDA_D)
JPMIC=LCMGID(IPMIC,'GROUP')
IF(NBMIX.NE.1) THEN
CALL XABORT('@D2PTH: MORE THAN ONE MIXTURE IN SAPHYB')
ENDIF
IF(NFISS.NE.1) THEN
CALL XABORT('@D2PTH: MORE THAN 1 FISSILE ISOTOPE IN MACROLIB')
ENDIF
DO IGR=1,NGP
KPMIC=LCMGIL(JPMIC,IGR)
IF(JOBOPT(7)=='T')CALL LCMGET(KPMIC,'OVERV',OVERV(IGR))
IF(JOBOPT(5)=='T')CALL LCMGET(KPMIC,'CHI',CHI(1:NFISS,IGR))
IF(JOBOPT(12)=='T') THEN
CALL LCMGET(KPMIC,'NUSIGF',NUSIGF(IGR))
CALL LCMGET(KPMIC,'FLUX-INTG',FLX(IGR))
DO ND=1,NDEL
WRITE(NUSID,' (A6, I2.2)') 'NUSIGF', ND
CALL LCMGET(KPMIC,NUSID,NUSIGF_D(ND,IGR))
ENDDO
ENDIF
ENDDO
IF(JOBOPT(12)=='T') THEN
DO ND=1,NDEL
DEN=0.
NUM(ND)=0.0
DO IGR= 1,NGP
DEN=DEN+NUSIGF(IGR)*FLX(IGR)
NUM(ND)=NUM(ND)+NUSIGF_D(ND,IGR)*FLX(IGR)
ENDDO
BETA_D(ND,NFISS)=NUM(ND)/DEN
ENDDO
! CALL XABORT ('STOP TEST')
ENDIF
IF(JOBOPT(9)=='T') THEN
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
CALL LCMGTC(IPDAT,'YLD_OPT',3,YLDOPT)
CALL LCMGET(IPDAT,'YLD_FIX',YLDFIX)
IF ((YLDOPT=='REF').OR.(YLDOPT=='MAN')) THEN
CALL LCMSIX(IPMIC,' ',0)
CALL LCMLEN(IPMIC,'ISOTOPESDENS',MI_REAL,ITYLCM)
CALL LCMLEN(IPMIC,'ISOTOPERNAME',MI,ITYLCM)
ALLOCATE (ISOTOPERNAME(MI))
CALL LCMGTC(IPMIC,'ISOTOPERNAME',12,MI,ISOTOPERNAME)
CALL LCMLEN(IPMIC,'DEPL-CHAIN',ILONG,ITYLCM)
IF (ILONG.EQ.0) THEN
YLDI=YLDFIX(1)
YLDXe=YLDFIX(2)
YLDPm=YLDFIX(3)
WRITE(6,*)"@D2PTH : NO RECORD DEPL-CHAIN IN SAP/MCO :"
WRITE(6,*)"=> DEFAULT VALUES FOR FISSION YLDS CONSIDERED"
ELSE
CALL LCMSIX(IPMIC,'DEPL-CHAIN',1)
CALL LCMGET(IPMIC,'STATE-VECTOR',DSTATE)
NDEPL = DSTATE(1)
NDFI = DSTATE(2)
NDFP = DSTATE(3)
MR = DSTATE(8)
ALLOCATE (FISSIONYIELD(NDFI*NDFP), DEPLETE_ENER(NDEPL*MR))
ALLOCATE (ISOTOPESDEPL(NDEPL), PF(NDEPL),DEPLETE_DECA(NDEPL))
CALL LCMGET(IPMIC,'DEPLETE-DECA',DEPLETE_DECA)
CALL LCMGET(IPMIC,'DEPLETE-ENER',DEPLETE_ENER)
CALL LCMGTC(IPMIC,'ISOTOPESDEPL',12,NDEPL,ISOTOPESDEPL)
IF ((NDFI.EQ.0 ).OR. (NDFP .EQ. 0)) THEN
WRITE(6,*) "@D2PTH : NUMBER OF DIRECT FISSILE ISOTOPES",
1 " OR FISSION FRAGMENT IS ZERO"
CALL XABORT('=> PLEASE TURN OFF THE LYLD FLAG IN JOB_OPT'
> //' OR USE THE "YLD FIX" OPTION' )
ENDIF
CALL LCMGET(IPMIC,'FISSIONYIELD',FISSIONYIELD)
I_PF=0
iso=1
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
CALL LCMGET(IPDAT,'BURN',BURN)
CALL LCMSIX (IPDAT,'ISOTOPES',1)
CALL LCMGTC (IPDAT,'XE135',12,ISOTOPES(1))
CALL LCMGTC (IPDAT,'SM149',12,ISOTOPES(2))
CALL LCMGTC (IPDAT,'I135',12,ISOTOPES(3))
CALL LCMGTC (IPDAT,'PM149',12,ISOTOPES(4))
DO iso=1, NDEPL
IF(INDEX(ISOTOPESDEPL(iso), 'MACR')==0) THEN
I_PF=I_PF+1
PF(I_PF)=ISOTOPESDEPL(iso)
IF(PF(I_PF)==ISOTOPES(3)) YLDI=FISSIONYIELD(I_PF)
IF(PF(I_PF)==ISOTOPES(1)) YLDXe=FISSIONYIELD(I_PF)
IF(PF(I_PF)==ISOTOPES(4)) YLDPm=FISSIONYIELD(I_PF)
ENDIF
ENDDO
IF(IPRINT > 1) THEN
WRITE(6,*)"********* STATE VECTOR INFORMATION *************"
WRITE(6,*)
WRITE(6,*)"Number of isotopes (MI) : ",MI
WRITE(6,*)"Number of groups (NGP) : ",NGP
WRITE(6,*)"Number of fissile isotopes (NFISS) : ",NFISS
WRITE(6,*)"Number of delayed neutron groups (NDEL) : ",NDEL
WRITE(6,*)"Number of depleted isotopes (NDEPL) : ",NDEPL
WRITE(6,*)"Number of direct fissile isotopes (NDFI) : ",NDFI
WRITE(6,*)"Number of fission fragments (NDFP) : ",NDFP
WRITE(6,*)"Maximum number of depleting reactions(MR): ",MR
WRITE(6,*)
WRITE(6,*)"**************** ISOTOPE NAME ******************"
WRITE(6,*)
WRITE(6,'(10A12)')ISOTOPERNAME(1:MI_REAL)
WRITE(6,*)
ENDIF
DEALLOCATE (ISOTOPERNAME)
DEALLOCATE (FISSIONYIELD,ISOTOPESDEPL,PF)
DEALLOCATE (DEPLETE_ENER,DEPLETE_DECA)
ENDIF
ELSE IF (YLDOPT=='FIX') THEN
YLDI=YLDFIX(1)
YLDXe=YLDFIX(2)
YLDPm=YLDFIX(3)
ENDIF
ENDIF
CALL LCMSIX(IPDAT,' ',0)
CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
CALL LCMGET(IPDAT,'STATE',STATE)
CALL LCMSIX(IPDAT,' ',0)
IF(STAIDX(NVAR)==1) THEN
IPTH=LCMLID(IPDAT,'TH_DATA',NBU)
ELSE
IPTH=LCMGID(IPDAT,'TH_DATA')
ENDIF
KPTH=LCMDIL(IPTH,STAIDX(NVAR))
IF(JOBOPT(13)=='T') THEN
CALL LCMPUT(KPTH,'LAMBDA',NDEL*NFISS,2,LAMBDA_D)
ENDIF
IF(JOBOPT(9)=='T') THEN
IF((YLDOPT.EQ.'FIX').OR.(YLDOPT.EQ.'REF')) THEN
CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPm)
CALL LCMPUT(KPTH,'YLDXe',1,2,YLDXe)
CALL LCMPUT(KPTH,'YLDI',1,2,YLDI)
ELSE IF ((YLDOPT.EQ.'MAN').AND.(FLAG.EQ.-1)) THEN
CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPm)
CALL LCMPUT(KPTH,'YLDXe',1,2,YLDXe)
CALL LCMPUT(KPTH,'YLDI',1,2,YLDI)
ENDIF
ENDIF
IF(JOBOPT(7)=='T')CALL LCMPUT(KPTH,'OVERV',NGP,2,OVERV)
IF(JOBOPT(5)=='T')CALL LCMPUT(KPTH,'CHI',NFISS*NGP,2,CHI)
IF(JOBOPT(12)=='T')CALL LCMPUT(KPTH,'BETA',NDEL*NFISS,2,BETA_D)
IF(IPRINT > 1) THEN
WRITE(6,*) "**************** T/H INFORMATION *****************"
IF(JOBOPT(5)=='T') WRITE(6,*) "CHI(NFISS,NGP) :",CHI
IF(JOBOPT(7)=='T') WRITE(6,*) "OVERV(NGP) :",OVERV
IF(JOBOPT(13)=='T')WRITE(6,*) "LAMBDA(NDEL,NFISS) :",LAMBDA_D
IF(JOBOPT(12)=='T')WRITE(6,*) "BETA(NDEL,NFISS) :",BETA_D
IF(JOBOPT(9)=='T') WRITE(6,*) "PM-149 YIELD :",YLDPm
IF(JOBOPT(9)=='T') WRITE(6,*) "XE-135 YIELD :",YLDXe
IF(JOBOPT(9)=='T') WRITE(6,*) "I-135 YIELD :",YLDI
WRITE(6,*)
ENDIF
END
|
