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
|
*DECK LIBND6
SUBROUTINE LIBND6(CFILNA,MAXR,NEL,ITNAM,KPAX,BPAX)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read depletion data on a NDAS formatted library.
*
*Copyright:
* Copyright (C) 2006 Ecole Polytechnique de Montreal
*
*Author(s): A. Hebert
*
*Parameters: input
* CFILNA NDAS file name.
* MAXR number of reaction types.
* NEL number of isotopes on library.
*
*Parameters: output
* ITNAM reactive isotope names in chain.
* KPAX complete reaction type matrix.
* BPAX complete branching ratio matrix.
*
*Reference:
* Copyright (C) from NDAS Atomic Energy of Canada Limited utility (2006)
*
*-----------------------------------------------------------------------
*
USE FSDF
IMPLICIT NONE
*----
* Subroutine arguments
*----
INTEGER MAXR,NEL,ITNAM(3,NEL),KPAX(NEL+MAXR,NEL)
CHARACTER CFILNA*(*)
REAL BPAX(NEL+MAXR,NEL)
*----
* Local variables
*----
CHARACTER TEXT8*8,TEXT12*12
INTEGER IND,J,IERR,HEADER(16),IHEAD(200),ISO,JSO,ISOID,NBCHIL,
> LIBWID
*----
* INTERNAL PARAMETERS
* CONVE : ENERGY CONVERSION FACTOR FROM JOULES/(MOLES*10**-24)
* TO MEV/NUCLIDE = 1.03643526E+13
* CONVD : DECAY CONSTANT CONVERSION FACTOR FROM S**(-1) TO
* 10**(-8)*S**(-1) = 1.0+8
*----
INTEGER KCAPTU,KDECAY,KFISSP,KN2N
REAL CONVE,CONVD
PARAMETER(KCAPTU=3,KDECAY=1,KFISSP=2,KN2N=4,CONVE=1.03643526E+13,
> CONVD=1.0E+8)
INTEGER NDECAY
DOUBLE PRECISION TOTLAM
EXTERNAL LIBWID
INTEGER, ALLOCATABLE, DIMENSION(:) :: CHILDR,IWISO
REAL, ALLOCATABLE, DIMENSION(:) :: BURNDA
*----
* Scratch storage allocation
*----
ALLOCATE(CHILDR(2*NEL),IWISO(NEL))
ALLOCATE(BURNDA(2*NEL))
*----
* Open and probe the NDAS file
*----
CALL XSDOPN(CFILNA,IERR)
IF(IERR.NE.0) THEN
TEXT12=CFILNA
CALL XABORT('LIBND6: NDAS library '//TEXT12//' cannot be'//
> ' opened')
ENDIF
CALL XSDBLD(6001,HEADER,IERR)
IF(IERR.NE.0) CALL XABORT('LIBND6: XSDBLD could not read library'
> //' parameters')
ISO=0
DO IND=1,HEADER(1)
* Load nuclide header
CALL XSDISO(7000,6001,IND,IHEAD,IERR)
NBCHIL=IHEAD(1)
IF(NBCHIL.GT.NEL) CALL XABORT('LIBND6: Children overflow')
IF(NBCHIL.NE.0) THEN
ISO=ISO+1
IF(ISO.GT.NEL) CALL XABORT('LIBND6: NEL overflow')
CALL XSDNAM(IND,IWISO(ISO),TEXT8,IERR)
IF(IERR.NE.0) CALL XABORT('LIBND6: XSDNAM index overflow')
ENDIF
ENDDO
ISO=0
DO IND=1,HEADER(1)
* Load nuclide header
CALL XSDISO(7000,6001,IND,IHEAD,IERR)
NBCHIL=IHEAD(1)
IF(NBCHIL.NE.0) THEN
ISO=ISO+1
NDECAY=0
TOTLAM=0.0D0
CALL XSDNAM(IND,ISOID,TEXT8,IERR)
READ(TEXT8,'(2A4)') ITNAM(1,ISO),ITNAM(2,ISO)
* Load burnup children data
CALL XSDISO(7000,5002,IND,CHILDR,IERR)
* Load burnup coefficients
CALL XSDISO(7000,5003,IND,BURNDA,IERR)
DO J=1,2*NBCHIL,2
JSO=LIBWID(NEL,IWISO,CHILDR(J))
IF(CHILDR(J+1).EQ.1) THEN
IF(JSO.GT.0) THEN
KPAX(JSO,ISO)=KCAPTU
BPAX(JSO,ISO)=BURNDA(J)
KPAX(NEL+KCAPTU,JSO)=1
ENDIF
KPAX(NEL+KCAPTU,ISO)=1
ELSE IF(CHILDR(J+1).EQ.2) THEN
NDECAY=NDECAY+1
TOTLAM=TOTLAM+DBLE(BURNDA(J))
IF(JSO.GT.0) THEN
KPAX(JSO,ISO)=KDECAY
BPAX(JSO,ISO)=BURNDA(J)
KPAX(NEL+KCAPTU,JSO)=1
ENDIF
KPAX(NEL+KDECAY,ISO)=1
ELSE IF(CHILDR(J+1).EQ.3) THEN
IF(JSO.GT.0) THEN
KPAX(JSO,ISO)=KFISSP
BPAX(JSO,ISO)=BURNDA(J)
KPAX(NEL+KFISSP,JSO)=-1
KPAX(NEL+KCAPTU,JSO)=1
ENDIF
ELSE IF(CHILDR(J+1).EQ.4) THEN
KPAX(NEL+KFISSP,ISO)=1
BPAX(NEL+KFISSP,ISO)=BURNDA(J)*CONVE
ELSE IF(CHILDR(J+1).EQ.5) THEN
IF(JSO.GT.0) THEN
KPAX(JSO,ISO)=KN2N
BPAX(JSO,ISO)=BURNDA(J)
KPAX(NEL+KCAPTU,JSO)=1
ENDIF
KPAX(NEL+KN2N,ISO)=1
ENDIF
ENDDO
IF(NDECAY .EQ. 1) THEN
BPAX(NEL+KDECAY,ISO)=REAL(TOTLAM)*CONVD
DO JSO=1,NEL
IF(KPAX(JSO,ISO).EQ. KDECAY) THEN
BPAX(JSO,ISO)=1.0
ENDIF
ENDDO
ELSE IF(NDECAY .GT. 1) THEN
BPAX(NEL+KDECAY,ISO)=REAL(TOTLAM)*CONVD
DO JSO=1,NEL
IF(KPAX(JSO,ISO).EQ. KDECAY) THEN
BPAX(JSO,ISO)=BPAX(JSO,ISO)/REAL(TOTLAM)
ENDIF
ENDDO
ENDIF
ENDIF
ENDDO
CALL XSDCL()
*----
* Scratch storage deallocation
*----
DEALLOCATE(BURNDA)
DEALLOCATE(IWISO,CHILDR)
RETURN
END
|
