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
|
*DECK LIBEAD
SUBROUTINE LIBEAD (IPLIB,MAXISO,MAXMIX,IMPX,NDEPL,NFISS,NSUPS,
1 NREAC,NPAR,NBISO,ISONAM,ISONRF,HLIB,ILLIB,MIX,TN,IEVOL,ITYP,
2 NCOMB)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Add the missing isotopes from the depletion chain.
*
*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): A. Hebert
*
*Parameters: input/output
* IPLIB pointer to the lattice microscopic cross section library
* (L_LIBRARY signature).
* MAXISO maximum value of nbiso.
* MAXMIX maximum number of mixtures.
* IMPX print flag. Equal to zero for no print.
* NDEPL number of depleting isotopes.
* NFISS number of fissiles isotopes producing fission products.
* NSUPS number of non-depleting isotopes producing energy.
* NREAC maximum number of depletion reactions.
* NPAR maximum number of parent nuclides in the depletion chain.
* NBISO old/new number of isotopes present in the calculation
* domain.
* ISONAM alias name of isotopes.
* ISONRF library name of isotopes.
* HLIB isotope options.
* ILLIB xs library index for each isotope.
* MIX mix number of each isotope (can be zero).
* TN temperature of each isotope.
* IEVOL non-depletion mask (=1/2 to suppress/force depletion of an
* isotope).
* ITYP isotope type:
* =1: the isotope is not fissile and not a fission product;
* =2: the isotope is fissile; =3: is a fission product.
* NCOMB number of depleting mixtures.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB
INTEGER MAXISO,MAXMIX,IMPX,NDEPL,NFISS,NSUPS,NREAC,NPAR,
1 NBISO,ISONAM(3,MAXISO),ISONRF(3,MAXISO),ILLIB(MAXISO),
2 MIX(MAXISO),IEVOL(MAXISO),ITYP(MAXISO),NCOMB
REAL TN(MAXISO)
CHARACTER(LEN=8) HLIB(MAXISO,4)
*----
* LOCAL VARIABLES
*----
PARAMETER (IOUT=6)
CHARACTER TEXT1*12,TEXT2*12,TEXT3*8
INTEGER, ALLOCATABLE, DIMENSION(:) :: MILVO,IIPAR,KFISS
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IDR,KPAR,HGAR
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(MILVO(MAXMIX),IIPAR(NDEPL),IDR(NREAC,NDEPL),
1 KPAR(NPAR,NDEPL),KFISS(NFISS),HGAR(3,NDEPL))
*----
* FIND THE NUMBER OF DEPLETING MIXTURES
*----
CALL LCMGET(IPLIB,'ISOTOPESDEPL',HGAR)
IF(NDEPL.GT.MAXISO) CALL XABORT('LIBEAD: TOO MANY DEPLETING ISOT'
1 //'OPES.')
CALL LCMGET(IPLIB,'DEPLETE-REAC',IDR)
CALL LCMGET(IPLIB,'PRODUCE-REAC',KPAR)
NCOMB=0
DO 30 ISOT=1,NBISO
IBM=MIX(ISOT)
IF(IBM.EQ.0) GO TO 30
IF((IEVOL(ISOT).NE.1).AND.(ITYP(ISOT).GT.1)) THEN
DO 10 J=1,NCOMB
IF(IBM.EQ.MILVO(J)) GO TO 30
10 CONTINUE
NCOMB=NCOMB+1
MILVO(NCOMB)=IBM
GO TO 30
ENDIF
IF((IEVOL(ISOT).EQ.1).OR.(ILLIB(ISOT).EQ.0)) GO TO 30
DO 20 I=1,NDEPL-NSUPS
IF((ISONRF(1,ISOT).EQ.HGAR(1,I)).AND.(ISONRF(2,ISOT).EQ.
1 HGAR(2,I)).AND.(ISONRF(3,ISOT).EQ.HGAR(3,I))) THEN
ITYP(ISOT)=1
IF(IEVOL(ISOT).EQ.2) ITYP(ISOT)=3
IF(MOD(IDR(2,I),100).EQ.3) ITYP(ISOT)=2
IF(MOD(IDR(2,I),100).EQ.4) ITYP(ISOT)=2
IF(MOD(IDR(2,I),100).EQ.5) ITYP(ISOT)=3
DO 15 J=1,NCOMB
IF(IBM.EQ.MILVO(J)) GO TO 30
15 CONTINUE
NCOMB=NCOMB+1
MILVO(NCOMB)=IBM
GO TO 30
ENDIF
20 CONTINUE
IEVOL(ISOT)=1
30 CONTINUE
*----
* ADD THE MISSING ISOTOPES FROM THE DEPLETION CHAIN
*----
KFISS(:NFISS)=0
DO 35 INUCL=1,NDEPL-NSUPS
IF(MOD(IDR(2,INUCL),100).EQ.4) THEN
KDRI=IDR(2,INUCL)/100
IF(KDRI.GT.NFISS) CALL XABORT('LIBEAD: INVALID NFISS.')
IF(KDRI.GT.0) KFISS(KDRI)=INUCL
ENDIF
35 CONTINUE
NBOLD=NBISO
DO 130 ICOMB=1,NCOMB
IBM=MILVO(ICOMB)
ITER=0
IFIRST=0
DO 36 I=1,NBISO
IF(MIX(I).EQ.IBM) THEN
IFIRST=I
GO TO 40
ENDIF
36 CONTINUE
CALL XABORT('LIBEAD: UNABLE TO FIND A DEPLETING MIXTURE.')
40 ITER=ITER+1
IF(ITER.GT.100) CALL XABORT('LIBEAD: UNABLE TO COMPLETE THE BURN'
1 //'UP CHAINS.')
NADD=0
DO 120 INUCL=1,NDEPL-NSUPS
DO 50 I=1,NBISO
IF((ISONRF(1,I).EQ.HGAR(1,INUCL)).AND.(ISONRF(2,I).EQ.
1 HGAR(2,INUCL)).AND.(ISONRF(3,I).EQ.HGAR(3,INUCL)).AND.
2 (MIX(I).EQ.IBM)) GO TO 120
50 CONTINUE
WRITE(TEXT1,'(3A4)') (HGAR(I0,INUCL),I0=1,3)
I1=INDEX(TEXT1,'_')
IF(I1.EQ.0) THEN
TEXT2=TEXT1
ELSE
TEXT2=TEXT1(:I1-1)
ENDIF
TEXT2(9:12)=' '
DO 60 I=1,NBISO
IF(MIX(I).NE.IBM) GO TO 60
WRITE(TEXT1,'(3A4)') (ISONRF(I0,I),I0=1,3)
I1=INDEX(TEXT1,'_')
IF(I1.EQ.0) THEN
TEXT3=TEXT1(:8)
ELSE
TEXT3=TEXT1(:I1-1)
ENDIF
IF(TEXT3.EQ.TEXT2(:8)) GO TO 120
60 CONTINUE
IIPAR(:NDEPL-NSUPS)=0
IF(MOD(IDR(2,INUCL),100).EQ.5) THEN
DO 70 IFIS=1,NFISS
IF(KFISS(IFIS).GT.0) IIPAR(KFISS(IFIS))=1
70 CONTINUE
ENDIF
DO 80 IPAR=1,NPAR
KGAR=KPAR(IPAR,INUCL)
IF(KGAR.EQ.0) THEN
GO TO 90
ELSE
IIPAR(KGAR/100)=1
ENDIF
80 CONTINUE
90 DO 110 JNUCL=1,NDEPL-NSUPS
IF(IIPAR(JNUCL).EQ.1) THEN
NBISOL=NBISO
DO 100 I=1,NBISOL
IF((ISONRF(1,I).EQ.HGAR(1,JNUCL)).AND.(ISONRF(2,I).EQ.
1 HGAR(2,JNUCL)).AND.(ISONRF(3,I).EQ.HGAR(3,JNUCL)).AND.
2 (MIX(I).EQ.IBM)) THEN
* A PARENT EXISTS. ADD ONE ISOTOPE IN THE ISOTOPE LIST AND
* SET ISOTOPE PARAMETERS TO STANDARD VALUES.
NBISO=NBISO+1
IF(NBISO.GT.MAXISO) CALL XABORT('LIBEAD: MAXISO TOO SMALL.')
NADD=NADD+1
IF(IMPX.GT.8) WRITE(IOUT,'(25H LIBEAD: ADDING ISOTOPE '',
1 3A4,20H'' TO CHILD ISOTOPE '',3A4,12H'' IN MIXTURE,I5)')
2 (HGAR(I0,INUCL),I0=1,3),(HGAR(I0,JNUCL),I0=1,3),IBM
* TEXT2 IS THE NEW ALIAS NAME FOR NBISO-TH ISOTOPE.
READ(TEXT2,'(3A4)') (ISONAM(I0,NBISO),I0=1,3)
DO 95 I0=1,3
ISONRF(I0,NBISO)=HGAR(I0,INUCL)
95 CONTINUE
HLIB(NBISO,1)=HLIB(IFIRST,1)
ILLIB(NBISO)=ILLIB(IFIRST)
MIX(NBISO)=IBM
TN(NBISO)=TN(IFIRST)
IEVOL(NBISO)=0
ITYP(NBISO)=1
IF(MOD(IDR(2,INUCL),100).EQ.3) ITYP(NBISO)=2
IF(MOD(IDR(2,INUCL),100).EQ.4) ITYP(NBISO)=2
IF(MOD(IDR(2,INUCL),100).EQ.5) ITYP(NBISO)=3
GO TO 120
ENDIF
100 CONTINUE
ENDIF
110 CONTINUE
120 CONTINUE
IF(NADD.GT.0) GO TO 40
IF((IMPX.GT.0).AND.(NBISO-NBOLD.GT.0)) THEN
WRITE(IOUT,150) NBISO-NBOLD,IBM
ENDIF
NBOLD=NBISO
130 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(HGAR,KFISS,KPAR,IDR,IIPAR,MILVO)
RETURN
*
150 FORMAT(/8H LIBEAD:,I5,39H DEPLETING ISOTOPES HAVE BEEN ADDED IN ,
1 7HMIXTURE,I5,1H.)
END
|
