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
|
*DECK INFWD4
SUBROUTINE INFWD4(CFILNA,IVERW,IPRINT,NBISO,HNAMIS,AWRISO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To recover mass for isotopes of WIMS-D4 or WIMS-E libraries.
*
*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, A. Hebert
*
*Parameters: input
* CFILNA WIMS file name.
* IVERW TYPE OF FILE (=4: WIMS-D4; =5: WIMS-E).
* IPRINT print flag.
* NBISO number of isotopes.
* HNAMIS isotope names.
*
*Parameters: output
* AWRISO isotope weights.
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
INTEGER IVERW,IOUT,IPRINT,NBISO,KDROPN,KDRCLS
PARAMETER (IOUT=6)
CHARACTER CFILNA*64,HNAMIS(NBISO)*8
REAL AWRISO(NBISO)
EXTERNAL KDROPN,KDRCLS
*----
* MEMORY ALLOCATION PARAMETERS
*----
INTEGER IBASE(1)
REAL RBASE(1)
COMMON RBASE
EQUIVALENCE (RBASE(1),IBASE(1))
*----
* WIMS-D4 LIBRARY PARAMETERS
*----
INTEGER IUNIT,IUTYPE,IACTO,IACTC,LRIND,MAXISO,LPZ
PARAMETER (IUTYPE=2,IACTO=2,IACTC=1,LRIND=0,MAXISO=246,LPZ=8)
CHARACTER CWISO(MAXISO)*8
INTEGER NPZ(LPZ),IWISO(MAXISO),NEL,NGROUP,IEL,IELRT,JEL,
> IDIEL,IZ,NFIEL,NTMP,NRIEL,IDUM,IERR,IT,JSO,ISOF,
> IP1OPT,ISORD(MAXISO)
REAL AWR,RDUM
IF(CFILNA.EQ.' ' )THEN
CALL XABORT('INFWD4: WIMS LIBRARY HAS NOT BEEN SET')
ENDIF
*----
* OPEN WIMS-D4 LIBRARY
* READ GENERAL DIMENSIONING
*----
IUNIT=KDROPN(CFILNA,IACTO,IUTYPE,LRIND)
IF(IUNIT.LE.0) CALL XABORT(
> 'INFWD4: WIMS-D4 LIBRARY CANNOT BE OPENED FOR MIXS :'//CFILNA)
READ(IUNIT) (NPZ(IT),IT=1,LPZ)
NEL=NPZ(1)
NGROUP=NPZ(2)
IF(NEL.GT.MAXISO) THEN
WRITE(IOUT,9000) MAXISO,NEL
CALL XABORT('INFWD4: INVALID NUMBER OF ISOTOPES')
ENDIF
IF(NBISO.GT.MAXISO) THEN
WRITE(IOUT,9001) NBISO,NEL
CALL XABORT('INFWD4: INVALID NUMBER OF ISOTOPES')
ENDIF
*----
* READ ISOTOPE ID NUMBER AND CREATE EQUIVALENT ISOTOPE NAME
* SCAN TO ASSOCIATE WIMS ISOTOPE NUMBER WITH DRAGON ISOTOPE NUMBER
* VERIFY IF ALL ISOTOPES REQUIRED ARE PRESENT
*----
READ(IUNIT) (IWISO(IEL),IEL=1,NEL)
DO 100 IEL=1,NEL
CWISO(IEL)=' '
IF (IWISO(IEL).LT.10) THEN
WRITE(CWISO(IEL),'(I1)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.100) THEN
WRITE(CWISO(IEL),'(I2)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.1000) THEN
WRITE(CWISO(IEL),'(I3)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.10000) THEN
WRITE(CWISO(IEL),'(I4)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.100000) THEN
WRITE(CWISO(IEL),'(I5)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.1000000) THEN
WRITE(CWISO(IEL),'(I6)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.10000000) THEN
WRITE(CWISO(IEL),'(I7)') IWISO(IEL)
ELSE IF(IWISO(IEL).LT.100000000) THEN
WRITE(CWISO(IEL),'(I8)') IWISO(IEL)
ENDIF
DO 101 JSO=1,NBISO
IF(HNAMIS(JSO).EQ.CWISO(IEL)) THEN
ISORD(JSO)=IEL
ENDIF
101 CONTINUE
100 CONTINUE
IF(IPRINT.GE.100) THEN
WRITE(IOUT,6000) (CWISO(IEL),IEL=1,NEL)
ENDIF
DO 102 JSO=1,NBISO
IF(ISORD(JSO).EQ.0) THEN
WRITE(IOUT,9002) HNAMIS(JSO),CFILNA
CALL XABORT('INFWD4: MISSING ISOTOPE')
ENDIF
102 CONTINUE
*----
* SKIP GROUP STRUCTURE, FISSION SPECTRUM, DEPLETION CHAIN
* AND END RECORD
*----
READ(IUNIT) RDUM
IF(IVERW.EQ.4) READ(IUNIT) RDUM
DO 110 IEL=1,NEL
READ(IUNIT) IDUM
110 CONTINUE
IF(IVERW.EQ.4) READ(IUNIT) RDUM
DO 120 IELRT=1,NEL
IF(IVERW.EQ.4) THEN
READ(IUNIT) IDIEL,AWR,IZ,NFIEL,NTMP,NRIEL
ISOF=0
IP1OPT=1
ELSE IF(IVERW.EQ.5) THEN
READ(IUNIT) IDIEL,AWR,IZ,NFIEL,NTMP,NRIEL,ISOF,IP1OPT
ENDIF
*----
* LOCATE ISOTOPE IN LIST OF LIBRARY ISOTOPES IN THE CASE
* WHERE LIBRARY IS NOT COMPLETE OR THE ORDER OF ISOTOPE
* STORED IS DIFFERENT FROM THAT OF THE ISOTOPE NAMES
*----
IEL=0
DO 121 JEL=1,NEL
IF(IDIEL.EQ.IWISO(JEL)) THEN
IEL=JEL
GO TO 125
ENDIF
121 CONTINUE
CALL XABORT('INFWD4: WIMSD4 LIBRARY INCOMPLETE')
125 CONTINUE
*----
* SCAN TO SEE IF ISOTOPE IS REQUIRED AND GET WEIGHTS.
*----
DO 150 JSO=1,NBISO
IF(ISORD(JSO).EQ.IEL) THEN
AWRISO(JSO)=AWR
GO TO 155
ENDIF
150 CONTINUE
155 CONTINUE
*----
* OTHER RECORDS FOR THIS ISOTOPE
*----
READ(IUNIT) RDUM
IF(NFIEL.GT.1) THEN
READ(IUNIT) RDUM
ENDIF
READ(IUNIT) IDUM
IF(NTMP.GT.0) THEN
READ(IUNIT) RDUM
DO 140 IT=1,NTMP
READ(IUNIT) RDUM
IF(NFIEL.GT.1) THEN
READ(IUNIT) RDUM
ENDIF
READ(IUNIT) IDUM
140 CONTINUE
ENDIF
IF(ISOF.NE.0) READ(IUNIT) RDUM
IF(IP1OPT.NE.1) THEN
DO 130 IT=1,NTMP
READ(IUNIT) IDUM
130 CONTINUE
ENDIF
IF(IVERW.EQ.4) READ(IUNIT) RDUM
120 CONTINUE
IERR=KDRCLS(IUNIT,IACTC)
IF(IERR.LT.0) CALL XABORT(
> 'INFWD4: Impossible to close WIMS-D4 library '//CFILNA)
*----
* RETURN
*----
RETURN
*----
* FORMAT
*----
9000 FORMAT(/' MAXIMUM NUMBER OF ISOTOPE SPECIFIED :',I10/
> ' NUMBER OF ISOTOPE IN LIBRARY :',I10)
9001 FORMAT(/' NUMBER OF ISOTOPE TO TREAT :',I10/
> ' NUMBER OF ISOTOPE IN LIBRARY :',I10)
9002 FORMAT(/' INFWD4: MATERIAL/ISOTOPE ',A64,
> ' IS MISSING ON WIMS-D4 FILE ',A8)
6000 FORMAT(1X,'ISOTOPES ON LIBRARY'/6(4X,A8))
END
|
