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
|
*DECK LIBWED
SUBROUTINE LIBWED(MAXR,NEL,NBESP,NDEPL,NDFI,NDFP,NHEAVY,NLIGHT,
> NOTHER,NREAC,NPAR,ITNAM,ITZEA,MATNO,KPAX,BPAX,
> HNADPL,IZEA,IDR,RER,RRD,KPAR,BPAR,YIELD)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Create /depletion/ records in /microlib/.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
*Author(s): G. Marleau
*
*Parameters: input
* MAXR number of reaction types.
* NEL number of isotopes on library.
* NBESP number of energy-dependent fission yield matrices.
* NDEPL number of depleting isotopes.
* NDFI number of direct fissile isotopes.
* NDFP number of direct fission product.
* NHEAVY number of heavy isotopes (fissile isotopes + decay +
* capture isotopes).
* NLIGHT number of light isotopes (fission product + decay +
* capture isotopes).
* NOTHER number of other isotopes (depleting isotopes + decay +
* capture isotopes).
* NREAC maximum number of depletion reaction in the depletion chain.
* NPAR maximum number of parent isopopes from decay and capture.
* ITNAM reactive isotope names in chain.
* ITZEA 6-digit nuclide identifier:
* atomic number z*10000 (digits) + mass number a*10 +
* energy state (0 = ground state, 1 = first state, etc.).
* MATNO reaction material index.
* KPAX complete reaction type matrix.
* BPAX complete branching ratio matrix.
*
*Parameters: output
* HNADPL reactive isotope names in chain.
* IZEA 6-digit nuclide identifier:
* atomic number z*10000 (digits) + mass number a*10 +
* energy state (0 = ground state, 1 = first state, etc.).
* IDR DEPLETE-REAC matrix (reaction identifiers).
* RER DEPLETE-ENER matrix (MeV/reaction values).
* RRD DEPLETE-DECA vector (decay constant values).
* KPAR PRODUCE-REAC matrix (production identifiers).
* BPAR PRODUCE-RATE matrix (branching ratios).
* YIELD fission product yield matrix.
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER MAXR,NEL,NBESP,NDEPL,NDFI,NDFP,NHEAVY,NLIGHT,NOTHER,NREAC,
> NPAR,ITNAM(3,NEL),ITZEA(NEL),MATNO(NEL),KPAX(NEL+MAXR,NEL),
> HNADPL(3,NDEPL),IZEA(NDEPL),IDR(NREAC,NDEPL),KPAR(NPAR,NDEPL)
REAL BPAX(NBESP,NEL+MAXR,NEL),RER(NREAC,NDEPL),RRD(NDEPL),
> BPAR(NPAR,NDEPL),YIELD(NBESP,NDFI,NDFP)
*----
* LOCAL VARIABLES
*----
CHARACTER TEXT4*4
INTEGER ITEXT4,ISOHEA,ISOLIG,ISOOTH,ISOSTA,ISO,ISONUM,IT,IEL,
> IPAR,JEL,JSO,IFI,IFP
*----
* INTERNAL PARAMETERS
*----
INTEGER KDECAY,KFISSP,KFISSI,KHEAT
PARAMETER (KDECAY=1,KFISSP=2,KFISSI=6,KHEAT=9)
*----
* INITIALIZE DECAY CHAIN
*----
TEXT4=' '
READ(TEXT4,'(A4)') ITEXT4
HNADPL(:3,:NDEPL)=ITEXT4
IZEA(:NDEPL)=0
IDR(:NREAC,:NDEPL)=0
KPAR(:NPAR,:NDEPL)=0
RER(:NREAC,:NDEPL)=0.0
RRD(:NDEPL)=0.0
BPAR(:NPAR,:NDEPL)=0.0
YIELD(:NBESP,:NDFI,:NDFP)=0.0
*----
* RENUMBER ISOTOPES AND SAVE IDR, RER AND RRD
*----
ISOHEA=0
ISOLIG=ISOHEA+NHEAVY
ISOOTH=ISOLIG+NLIGHT
ISOSTA=ISOOTH+NOTHER
DO 100 ISO=NEL,1,-1
ISONUM=0
IF(MATNO(ISO).EQ.-KFISSI) THEN
ISOHEA=ISOHEA+1
ISONUM=ISOHEA
ELSE IF(MATNO(ISO).EQ.-KFISSP) THEN
ISOLIG=ISOLIG+1
ISONUM=ISOLIG
ELSE IF(MATNO(ISO).EQ.-KDECAY) THEN
ISOOTH=ISOOTH+1
ISONUM=ISOOTH
ELSE IF(MATNO(ISO).EQ.-KHEAT) THEN
ISOSTA=ISOSTA+1
ISONUM=ISOSTA
ENDIF
IF(ISONUM.GT.0) THEN
MATNO(ISO)=ISONUM
HNADPL(1,ISONUM)=ITNAM(1,ISO)
HNADPL(2,ISONUM)=ITNAM(2,ISO)
HNADPL(3,ISONUM)=ITNAM(3,ISO)
IZEA(ISONUM)=ITZEA(ISO)
IDR(1,ISONUM)=KPAX(NEL+1,ISO)
RRD(ISONUM)=BPAX(1,NEL+1,ISO)
DO 101 IT=2,NREAC
IDR(IT,ISONUM)=KPAX(NEL+IT,ISO)
RER(IT,ISONUM)=BPAX(1,NEL+IT,ISO)
101 CONTINUE
ENDIF
100 CONTINUE
*----
* CREATE KPAR AND BPAR MATRIX
*----
DO 110 IEL=1,NEL
ISO=MATNO(IEL)
IF(ISO.GT.0) THEN
IPAR=0
DO 111 JEL=1,NEL
JSO=MATNO(JEL)
IF(JSO.GT.0) THEN
IF((KPAX(IEL,JEL).NE.0).AND.(KPAX(IEL,JEL).NE.KFISSP))
> THEN
IPAR=IPAR+1
IF(IPAR.GT.NPAR)
> CALL XABORT('LIBWED: TOO MANY DECAY PARENTS')
KPAR(IPAR,ISO)=JSO*100+KPAX(IEL,JEL)
BPAR(IPAR,ISO)=BPAX(1,IEL,JEL)
ENDIF
ENDIF
111 CONTINUE
ENDIF
110 CONTINUE
*----
* CREATE YIELD MATRIX
*----
DO 120 IEL=1,NEL
ISO=MATNO(IEL)
IF(ISO.GT.0) THEN
IF(MOD(IDR(KFISSP,ISO),100).EQ.4) THEN
IFI=IDR(KFISSP,ISO)/100
IF(IFI.EQ.0) GO TO 120
IF(IFI.GT.NDFI)
> CALL XABORT('LIBWED: INVALID FISSILE ISOTOPE NUMBER')
DO 121 JEL=1,NEL
JSO=MATNO(JEL)
IF(JSO.GT.0) THEN
IF(MOD(IDR(KFISSP,JSO),100).EQ.2) THEN
GO TO 121
ELSE IF(MOD(IDR(KFISSP,JSO),100).EQ.5) THEN
IFP=IDR(KFISSP,JSO)/100
IF(IFP.GT.NDFP) CALL XABORT('LIBWED: INVALID FI'//
> 'SSION PRODUCT NUMBER')
IF(KPAX(JEL,IEL) .EQ. KFISSP) THEN
YIELD(:,IFI,IFP)=BPAX(:,JEL,IEL)
ENDIF
ENDIF
ENDIF
121 CONTINUE
ENDIF
ENDIF
120 CONTINUE
*----
* RETURN
*----
RETURN
END
|
