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
|
*DECK INFTR1
SUBROUTINE INFTR1(CFILNA,IPRINT,NBISO,HNAMIS,AWRISO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To recover mass for isotopes of MATXS type libraries
* use MATXS format from NJOY-II or NJOY89.
*
*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
* CFILNA file name.
* IPRINT print flag.
* NBISO number of isotopes.
* HNAMIS isotope names.
*
*Parameters: output
* AWRISO isotope weights.
*
*Reference:
* R. E. MACFARLANE, TRANSX-CTR: A code for interfacing
* MATXS cross-section libraries to nuclear transport codes for
* fusion systems analysis, Los Alamos National Laboratory,
* Report LA-9863-MS, New Mexico, February 1984.
*
*-----------------------------------------------------------------------
*
USE XDRMOD
IMPLICIT NONE
INTEGER IPRINT,NBISO
CHARACTER CFILNA*64,HNAMIS(NBISO)*8
REAL AWRISO(NBISO)
*----
* LOCAL VARIABLES
*----
INTEGER IOUT,MULT,MAXA
CHARACTER FORM*4
PARAMETER (IOUT=6,MULT=2,MAXA=1000,FORM='(A6)')
*----
* FUNCTIONS
*----
INTEGER KDROPN,KDRCLS
DOUBLE PRECISION XDRCST
INTEGER NIN,IREC,NWDS,NPART,NTYPE,L2,L2H,IRZT,IT,
> NDEX,NMAT,NINP,NING,NOUTP,NOUTG,LOCT,LMC,
> IRZM,IM,ISO,LOC,IER,IA(MAXA)
CHARACTER HSMG*131,HTYPE*6,HMAT*6
REAL RA(MAXA)
DOUBLE PRECISION DA(MAXA/2)
REAL CONVM
EQUIVALENCE (RA(1),IA(1),DA(1))
*----
* OPEN MATXS FILE AND INITIALIZE LIBRARY
*----
CONVM=REAL(XDRCST('Neutron mass','amu'))
NIN=KDROPN(CFILNA,2,2,0)
IF(NIN.LE.0) THEN
WRITE(HSMG,9000) CFILNA
CALL XABORT(HSMG)
ENDIF
IREC=2
NWDS=3
*-------FILE CONTROL---------------
CALL XDREED(NIN,IREC,RA,NWDS)
*----------------------------------
NPART=IA(1)
NTYPE=IA(2)
IREC=4
NWDS=(NPART+NTYPE)*MULT+6*NTYPE+NPART
IF(NWDS.GT.MAXA) CALL XABORT
> ('INFTR1: LENGTH OF RECORD 4 > MAXA ')
*-------FILE DATA------------------
CALL XDREED(NIN,IREC,RA,NWDS)
*----------------------------------
IF((NWDS/2)*2.NE.NWDS) NWDS=NWDS+1
L2=1+NWDS
L2H=(L2-1)/MULT+1
IRZT=5+NPART
*----
* DATA TYPE LOOP
*----
DO 100 IT=1,NTYPE
WRITE(HTYPE,FORM) DA(NPART+IT)
CALL XDRCAS('LOWTOUP',HTYPE)
IF(HTYPE.NE.'NSCAT'.AND.HTYPE.NE.'NTHERM') GO TO 105
NDEX=(NPART+NTYPE)*MULT+IT
NMAT=IA(NDEX)
NDEX=NDEX+NTYPE
NINP=IA(NDEX)
NDEX=NDEX+NTYPE
NING=IA(NDEX)
NDEX=NDEX+NTYPE
NOUTP=IA(NDEX)
NDEX=NDEX+NTYPE
NOUTG=IA(NDEX)
NDEX=NDEX+NTYPE
LOCT=IA(NDEX)
*----
* DATA TYPE CONTROL
*----
IREC=LOCT+IRZT
NWDS=(2+MULT)*NMAT+NINP+NOUTP+1
IF(L2+NWDS-1.GT.MAXA) CALL XABORT
> ('INFTR1: LENGTH OF CURRENT RECORD > MAXA ')
*----------------------------------------
CALL XDREED(NIN,IREC,RA(L2),NWDS)
*----------------------------------------
IF((NWDS/2)*2.NE.NWDS) NWDS=NWDS+1
LMC=L2+NWDS
IRZM=IREC+1
*----
* READ THROUGH MATXS FILE AND GET AWR FOR ISOTOPES
*----
DO 110 IM=1,NMAT
WRITE(HMAT,FORM) DA(L2H-1+IM)
DO 120 ISO=1,NBISO
IF(HMAT.EQ.HNAMIS(ISO)(:6)) THEN
LOC=L2-1+MULT*NMAT+IM
IREC=IA(LOC+NMAT)+IRZM
NWDS=MULT+1+6*IA(LOC)
IF(LMC+NWDS-1.GT.MAXA) CALL XABORT
> ('INFTR1: LENGTH OF CURRENT RECORD > MAXA ')
*-------------------------------------------
CALL XDREED(NIN,IREC,RA(LMC),NWDS)
*-------------------------------------------
AWRISO(ISO)=RA(LMC+MULT)*CONVM
IF(IPRINT.GE.100) THEN
WRITE(IOUT,6000) HNAMIS(ISO),AWRISO(ISO)
ENDIF
ENDIF
120 CONTINUE
110 CONTINUE
105 CONTINUE
100 CONTINUE
*----
* CLOSE MATXS FILE.
*----
CALL XDRCLS(NIN)
IER=KDRCLS(NIN,1)
IF(IER.LT.0) THEN
WRITE(HSMG,9001) CFILNA
CALL XABORT(HSMG)
ENDIF
RETURN
*----
* PRINT FORMATS
*----
6000 FORMAT(' MATXS ISOTOPE =',A8,
> ' HAS ATOMIC WEIGHT RATIO = ',F10.3)
*----
* ABORT FORMATS
*----
9000 FORMAT('INFTR1: UNABLE TO OPEN MATXS LIBRARY FILE ',A64)
9001 FORMAT('INFTR1: UNABLE TO CLOSE MATXS LIBRARY FILE ',A64)
END
|
