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
|
*DECK CPOISO
SUBROUTINE CPOISO(IPRINT,IEXTRC,NMERGE,MAXISO,MAXISM,NBMICR,
> NISCPO,NISEXT,ISOCPO,ISOEXT,ISOORD,ISOTMP,
> IMXTMP,IDIMIX,NBIMRG,ICOMIX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Identify isotopes to be extracted from macroscopic xs and isotopes
* included in new combined isotopes.
*
*Copyright:
* Copyright (C) 2007 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
* IPRINT print parameter. Equal to zero for no print.
* IEXTRC type of extraction: 1 for part 2 for all.
* NMERGE number of region.
* MAXISO maximum nunber of isotopes permitted.
* MAXISM maximum nunber of isotopes per region.
* NBMICR maximum number of isotopes in EDIT.
* NISCPO number of Compo isotopes treated.
* NISEXT number of extracted isotopes treated.
* ISOCPO Compo name of isotopes.
* ISOEXT name of extracted isotopes.
* ISOORD order of extracted isotopes.
* ISOTMP name of isotopes in EDIT.
* IMXTMP mixture of isotopes in EDIT.
*
*Parameters: output
* IDIMIX isotopes identifier in each Compo material.
* NBIMRG final number of isotope per region.
* ICOMIX pointer to Compo isotope for region.
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER IPRINT,IEXTRC,NMERGE,MAXISO,MAXISM,NBMICR,NISCPO,
> NISEXT,ISOCPO(3,MAXISO),
> ISOEXT(3,MAXISO),ISOORD(MAXISO),ISOTMP(3,NBMICR),
> IMXTMP(NBMICR),IDIMIX(NMERGE,NBMICR),
> NBIMRG(NMERGE),ICOMIX(NMERGE,MAXISM)
*----
* LOCAL PARAMETERS
*----
INTEGER IOUT
CHARACTER TEXT4*4
PARAMETER (IOUT=6)
INTEGER ISOM,ISOE,ISOC,IMRG,ITEXT4,ITC
INTEGER, ALLOCATABLE, DIMENSION(:) :: IDETMP
*----
* SCRATCH STORAGE ALLOCATION
* IDETMP extracted isotopes number associated with EDIT isotope.
*----
ALLOCATE(IDETMP(NBMICR))
IDETMP(:NBMICR)=0
*----
* STORE IN ITEXT4 BLANCK STRING
*----
TEXT4=' '
READ(TEXT4,'(A4)') ITEXT4
*----
* IF EXTRACT ALL USED (IEXTRC=2)
* GENERATE ISOCPO, ISOEXT AND ISOORD
* ASSOCIATE WITH ALL ISOTOPES EXTRACTED ISOTOPE NUMBER
* NAMELY IDETMP(ISOM)=ISOEXT(ISOE)
*----
IF(IEXTRC.EQ.2) THEN
NISEXT=0
DO 100 ISOM=1,NBMICR
DO 110 ISOE=1,NISEXT
IF(ISOEXT(1,ISOE).EQ.ISOTMP(1,ISOM).AND.
> ISOEXT(2,ISOE).EQ.ISOTMP(2,ISOM)) GO TO 115
110 CONTINUE
IF(NISEXT.EQ.MAXISO) THEN
WRITE(IOUT,7000) MAXISO,ISOTMP(1,ISOM),ISOTMP(2,ISOM)
ELSE
NISEXT=NISEXT+1
ISOEXT(1,NISEXT)=ISOTMP(1,ISOM)
ISOEXT(2,NISEXT)=ISOTMP(2,ISOM)
ISOEXT(3,NISEXT)=ITEXT4
ISOCPO(1,NISEXT)=ISOTMP(1,ISOM)
ISOCPO(2,NISEXT)=ISOTMP(2,ISOM)
ISOCPO(3,NISEXT)=ITEXT4
ISOORD(NISEXT)=NISEXT
IDETMP(ISOM)=NISEXT
ENDIF
115 CONTINUE
100 CONTINUE
NISCPO=NISEXT
ELSE
*----
* IF SPECIFIC ISOTOPES EXTRACTED (IEXTRC=1)
* FOR GENERIC EXTRACTED NAME (ISOEXT(3,ISOE)=' ')
* ASSOCIATE WITH SET OF ISOTOPE EXTRACTED ISOTOPE NUMBER
* NAMELY IDETMP(ISOM)=ISOEXT(ISOE)
* FOR EXPLICIT EXTRACTED NAMES
* ASSOCIATE WITH SPECIFIC ISOTOPE EXTRACTED ISOTOPE NUMBER
* NAMELY IDETMP(ISOM)=ISOEXT(ISOE)
*----
DO 120 ISOE=1,NISEXT
IF(ISOEXT(3,ISOE).EQ.ITEXT4) THEN
DO 130 ISOM=1,NBMICR
IF(ISOEXT(1,ISOE).EQ.ISOTMP(1,ISOM).AND.
> ISOEXT(2,ISOE).EQ.ISOTMP(2,ISOM)) THEN
IDETMP(ISOM)=ISOE
ENDIF
130 CONTINUE
ELSE
DO 140 ISOM=1,NBMICR
IF(ISOEXT(1,ISOE).EQ.ISOTMP(1,ISOM).AND.
> ISOEXT(2,ISOE).EQ.ISOTMP(2,ISOM).AND.
> ISOEXT(3,ISOE).EQ.ISOTMP(3,ISOM)) THEN
IDETMP(ISOM)=ISOE
ENDIF
140 CONTINUE
ENDIF
120 CONTINUE
ENDIF
*----
* IDENTIFY EXTRACTED ISOTOPES
*----
DO 150 ISOM=1,NBMICR
IMRG=IMXTMP(ISOM)
ISOE=IDETMP(ISOM)
IF(IMRG.NE.0.AND.ISOE.NE.0) THEN
IDIMIX(IMRG,ISOM)=ISOORD(ISOE)
ENDIF
150 CONTINUE
*----
* COMPUTED NUMBER OF ISOTOPES PER MIXTURE
*----
DO 160 IMRG=1,NMERGE
NBIMRG(IMRG)=0
DO 170 ISOM=1,NBMICR
ISOC=IDIMIX(IMRG,ISOM)
IF(ISOC.NE.0) THEN
DO 180 ISOE=1,NBIMRG(IMRG)
IF(ISOC.EQ.ICOMIX(IMRG,ISOE)) GO TO 185
180 CONTINUE
NBIMRG(IMRG)=NBIMRG(IMRG)+1
ICOMIX(IMRG,NBIMRG(IMRG))=ISOC
185 CONTINUE
ENDIF
170 CONTINUE
160 CONTINUE
IF(IPRINT.GE.1) THEN
WRITE(IOUT,6000)
DO 190 IMRG=1,NMERGE
IF(NBIMRG(IMRG).GT.0) THEN
DO 191 ISOM=1,NBMICR
ISOC=IDIMIX(IMRG,ISOM)
IF(ISOC.NE.0) THEN
WRITE(IOUT,6001) IMRG,(ISOCPO(ITC,ISOC),ITC=1,3),
> (ISOTMP(ITC,ISOM),ITC=1,3)
ENDIF
191 CONTINUE
ENDIF
190 CONTINUE
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(IDETMP)
RETURN
*----
* PRINT FORMAT
*----
6000 FORMAT(' CPO: LIST OF EXTRACTED ISOTOPES:'/
> 10X,'REGION',10X,'CPO NAME ',10X,'EDIT NAME ')
6001 FORMAT(10X,I6,10X,3A4,' CONTAINS ',3A4)
*----
* WARNING FORMAT
*----
7000 FORMAT(' CPOISO: ****** WARNING ******'/
> ' MAXIMUM NUMBER OF ISOTOPE REACHED = ',I8/
> ' SKIP GENERIC ISOTOPE NAME = ',2A4/
> ' *****************************')
END
|
