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
|
*DECK LIBCMB
SUBROUTINE LIBCMB(MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB,VOLTOT,
> VOLFRA,DENMIX,ISONAM,ISONRF,SHINA,ISOMIX,HLIB,
> ILLIB,DENISO,TMPISO,LSHI,SNISO,SBISO,NTFG,NIR,
> GIR,MASKI,IEVOL,ITYP)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Combine mixtures by volume fraction.
*
*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/output
* MAXMIX maximum value of nbmix.
* MAXISO maximum number of isotopes permitted.
* NBISO number of isotopes before combination.
* NEWISO number of isotopes after combination.
* NNMIX new mixture to create or modify.
* MIXCMB mixture to add.
* VOLTOT total volume fraction to date.
* VOLFRA volume fraction of current mixture.
* DENMIX density of each mixture.
* ISONAM name of isotopes.
* ISONRF reference name of isotopes.
* SHINA self-shielding name of isotopes.
* ISOMIX mix number of each isotope.
* HLIB isotope options.
* ILLIB xs library index for each isotope.
* DENISO density of isotopes.
* TMPISO temperature of isotopes.
* LSHI self-shielding flag.
* SNISO dilution cross section.
* SBISO dilution cross section used in Livolant-Jeanpierre
* normalization.
* NTFG number of thermal inelastic groups,
* NIR Goldstein-Cohen flag:
* use IR approximation for groups with index.ge.NIR;
* use library value if NIR=0.
* GIR Goldstein-Cohen IR parameter of each isotope.
* MASKI treat isotope logical.
* IEVOL depletion suppression flag (=1/2 to suppress/force depletion).
* ITYP type of isotope.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB,
> ISONAM(3,MAXISO),ISONRF(3,MAXISO),ISOMIX(MAXISO),
> ILLIB(MAXISO),LSHI(MAXISO),NTFG(MAXISO),NIR(MAXISO),
> IEVOL(MAXISO),ITYP(MAXISO)
LOGICAL MASKI(MAXISO)
REAL VOLTOT,VOLFRA,DENMIX(MAXMIX),DENISO(MAXISO),
> TMPISO(MAXISO),SNISO(MAXISO),SBISO(MAXISO),
> GIR(MAXISO)
CHARACTER(LEN=12) SHINA(MAXISO)
CHARACTER(LEN=8) HLIB(MAXISO,4)
DOUBLE PRECISION TOTWPC
*----
* LOCAL PARAMETERS
*----
CHARACTER HSMG*131
*
CMBVOL=VOLTOT+VOLFRA
IF(MIXCMB.EQ.NNMIX) GO TO 150
RMAS1=1.0
RMAS2=1.0
IF(MIXCMB.EQ.0) THEN
*----
* MIXTURE TO ADD IS VOID
*----
IF(DENMIX(NNMIX).EQ.-1.0) THEN
*----
* REDUCE ATOMIC DENSITY
*----
RMAS1=VOLTOT/CMBVOL
ELSE
*----
* REDUCE MIXTURE DENSITY BUT NOT WEIGHT PERCENT
*----
DENMIX(NNMIX)=DENMIX(NNMIX)*VOLTOT/CMBVOL
ENDIF
ELSE
*----
* MIXTURE TO ADD IS NOT VOID
*----
IF(DENMIX(NNMIX).EQ.-1.0) THEN
IF(DENMIX(MIXCMB).EQ.-1.0) THEN
*----
* REDUCE ATOMIC DENSITY
*----
RMAS1=VOLTOT/CMBVOL
RMAS2=VOLFRA/CMBVOL
ELSE
IF(VOLTOT.GT.0.0)
> CALL XABORT('LIBCMB: CANNOT COMBINE MIXTURE WITH '//
> ' WEIGHT PERCENT AND ATOM CONTENTS')
*----
* TRANSFER MIXTURE DENSITY WITH INITIAL WEIGHT PERCENT TO NEWISO
*----
DENMIX(NNMIX)=DENMIX(MIXCMB)
ENDIF
ELSE
IF(DENMIX(MIXCMB).EQ.-1.0)
> CALL XABORT('LIBCMB: CANNOT COMBINE MIXTURE WITH '//
> ' WEIGHT PERCENT AND ATOM CONTENTS')
*----
* REDUCE MIXTURE DENSITY AND WEIGHT PERCENT FOR OLD ISO
* TRANSFER MIXTURE DENSITY WITH REDUCED WEIGHT PERCENT TO NEWISO
*----
RMAS1=VOLTOT*DENMIX(NNMIX)
RMAS2=VOLFRA*DENMIX(MIXCMB)
CMBMAS=RMAS1+RMAS2
RMAS1=RMAS1/CMBMAS
RMAS2=RMAS2/CMBMAS
DENMIX(NNMIX)=CMBMAS/CMBVOL
ENDIF
ENDIF
NEWISO=NBISO
*----
* RESET OLD DENSITIES
*----
IF(VOLTOT.EQ.0.0) THEN
DO 90 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.NNMIX) THEN
IF(MASKI(ISO)) THEN
WRITE(HSMG,'(15HLIBCMB: MIXTURE,I6,18H IS ALREADY DEFINE,
> 14HD FOR ISOTOPE ,3A4,1H.)') NNMIX,(ISONAM(I,ISO),I=1,3)
CALL XABORT(HSMG)
ENDIF
ISOMIX(ISO)=0
ENDIF
90 CONTINUE
ENDIF
IF(DENMIX(MIXCMB).EQ.-1.0) THEN
TOTWPC=1.0D0
ELSE
TOTWPC=0.0D0
DO ISO=1,NBISO
IF(ISOMIX(ISO).EQ.MIXCMB) THEN
TOTWPC=TOTWPC+DBLE(DENISO(ISO))
ENDIF
ENDDO
TOTWPC=1.0D0/TOTWPC
ENDIF
DO 100 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.NNMIX) THEN
DENISO(ISO)=DENISO(ISO)*RMAS1
ENDIF
100 CONTINUE
DO 110 ISO=1,NBISO
IF(ISOMIX(ISO).EQ.MIXCMB) THEN
*----
* SCAN ISO IN NNMIX TO IDENTIFY IDENTICAL ISOTOPES
*----
DO 111 JSO=1,NBISO
IF(ISOMIX(JSO).EQ.NNMIX) THEN
IF(ISONRF(1,JSO).EQ.ISONRF(1,ISO).AND.
> ISONRF(2,JSO).EQ.ISONRF(2,ISO)) THEN
IF(ISONAM(1,JSO).NE.ISONAM(1,ISO).OR.
> ISONAM(2,JSO).NE.ISONAM(2,ISO).OR.
> TMPISO(JSO) .NE.TMPISO(ISO) .OR.
> LSHI(JSO) .NE.LSHI(ISO) .OR.
> SNISO(JSO) .NE.SNISO(ISO) .OR.
> SBISO(JSO) .NE.SBISO(ISO) ) THEN
WRITE(HSMG,'(17HLIBCMB: ISOTOPES ,3A4,5H AND ,3A4,
> 18H CANNOT BE MERGED.)') (ISONAM(I,ISO),I=1,3),
> (ISONAM(I,JSO),I=1,3)
CALL XABORT(HSMG)
ENDIF
DENISO(JSO)=DENISO(JSO)+REAL(TOTWPC)*DENISO(ISO)*RMAS2
GO TO 115
ENDIF
ENDIF
111 CONTINUE
ISO2=0
DO 112 JSO=1,NBISO
IF(ISOMIX(JSO).EQ.0) THEN
ISO2=JSO
GO TO 113
ENDIF
112 CONTINUE
NEWISO=NEWISO+1
IF(NEWISO.GT.MAXISO) CALL XABORT('LIBCMB: MAXISO OVERFLOW.')
ISO2=NEWISO
113 ISOMIX(ISO2)=NNMIX
DENISO(ISO2)=REAL(TOTWPC)*DENISO(ISO)*RMAS2
TMPISO(ISO2)=TMPISO(ISO)
NTFG(ISO2)=NTFG(ISO)
NIR(ISO2)=NIR(ISO)
GIR(ISO2)=GIR(ISO)
SNISO(ISO2)=SNISO(ISO)
SBISO(ISO2)=SBISO(ISO)
LSHI(ISO2)=LSHI(ISO)
MASKI(ISO2)=.TRUE.
IEVOL(ISO2)=IEVOL(ISO)
ITYP(ISO2)=ITYP(ISO)
DO 120 ITC=1,3
ISONAM(ITC,ISO2)=ISONAM(ITC,ISO)
ISONRF(ITC,ISO2)=ISONRF(ITC,ISO)
120 CONTINUE
SHINA(ISO2)=SHINA(ISO)
DO 140 ILC=1,4
HLIB(ISO2,ILC)=HLIB(ISO,ILC)
140 CONTINUE
ILLIB(ISO2)=ILLIB(ISO)
ENDIF
115 CONTINUE
110 CONTINUE
150 NBISO=NEWISO
VOLTOT=CMBVOL
RETURN
END
|
