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
|
*DECK KINXSD
SUBROUTINE KINXSD(IPMAC,NGR,NBM,NBFIS,NDG,EVL,DT,DNF,DNS,LNUD,
1 LCHD,OVR,CHI,CHD,SGF,SGD)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover the 1/v and fission properties from L_MACROLIB which will be
* used for assembling source and kinetics matrix systems.
*
*Copyright:
* Copyright (C) 2010 Ecole Polytechnique de Montreal.
*
*Author(s): A. Hebert
*
*Parameters: input
* IPMAC pointer to L_MACROLIB object.
* NGR number of energy groups.
* NBM number of material mixtures.
* NBFIS number of fissile isotopes.
* NDG number of delayed-neutron groups.
* EVL steady-state eigenvalue.
* DNF delayed neutron fractions (from module input).
* DNS delayed neutron spectrum (from module input).
* LNUD flag: =.true. if DNF provided from module input.
* LCHD flag: =.true. if DNS provided from module input.
*
*Parameters: output
* OVR reciprocal neutron velocities/DT.
* CHI steady-state fission spectrum.
* CHD delayed fission spectrum
* SGF nu*fission macroscopic x-sections/keff.
* SGD delayed nu*fission macroscopic x-sections/keff.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC
INTEGER NGR,NBM,NBFIS,NDG
REAL EVL,DT,DNF(NDG),DNS(NDG,NGR),OVR(NBM,NGR),CHI(NBM,NBFIS,NGR),
1 CHD(NBM,NBFIS,NGR,NDG),SGF(NBM,NBFIS,NGR),SGD(NBM,NBFIS,NGR,NDG)
LOGICAL LNUD,LCHD
*----
* LOCAL VARIABLES (AUTOMATIC ALLOCATION)
*----
LOGICAL LFIS,LFISD
CHARACTER TEXT12*12
TYPE(C_PTR) JPMAC,KPMAC
*----
* PROCESS FISSION SPECTRUM TERMS.
*----
CHI(:NBM,:NBFIS,:NGR)=0.0
CHD(:NBM,:NBFIS,:NGR,:NDG)=0.0
SGF(:NBM,:NBFIS,:NGR)=0.0
SGD(:NBM,:NBFIS,:NGR,:NDG)=0.0
JPMAC=LCMGID(IPMAC,'GROUP')
KPMAC=LCMGIL(JPMAC,1)
CALL LCMLEN(KPMAC,'CHI',LENGT,ITYLCM)
IF(LENGT.GT.0) THEN
IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH FO'
1 //'R CHI INFORMATION.')
DO 10 IGR=1,NGR
KPMAC=LCMGIL(JPMAC,IGR)
CALL LCMGET(KPMAC,'CHI',CHI(1,1,IGR))
10 CONTINUE
ELSE
DO 22 IBM=1,NBM
DO 21 IFIS=1,NBFIS
CHI(IBM,IFIS,1)=1.0
DO 20 IGR=2,NGR
CHI(IBM,IFIS,IGR)=0.0
20 CONTINUE
21 CONTINUE
22 CONTINUE
ENDIF
IF(LCHD) THEN
DO 33 IDEL=1,NDG
DO 32 IGR=1,NGR
DO 31 IFIS=1,NBFIS
DO 30 IBM=1,NBM
CHD(IBM,IFIS,IGR,IDEL)=DNS(IDEL,IGR)
30 CONTINUE
31 CONTINUE
32 CONTINUE
33 CONTINUE
ELSE
KPMAC=LCMGIL(JPMAC,1)
CALL LCMLEN(KPMAC,'CHI01',LENGT,ITYLCM)
IF(LENGT.GT.0) THEN
IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH '
1 //'FOR DELAYED CHI INFORMATION.')
DO 42 IDEL=1,NDG
WRITE(TEXT12,'(3HCHI,I2.2)') IDEL
DO 40 IGR=1,NGR
KPMAC=LCMGIL(JPMAC,IGR)
CALL LCMGET(KPMAC,TEXT12,CHD(1,1,IGR,IDEL))
40 CONTINUE
42 CONTINUE
ELSE
CHD(:NBM,:NBFIS,:NGR,:NDG)=0.0
ENDIF
ENDIF
LFIS=.FALSE.
LFISD=.FALSE.
DO 52 IGR=1,NGR
DO 51 IFIS=1,NBFIS
DO 50 IBM=1,NBM
LFIS=LFIS.OR.(CHI(IBM,IFIS,IGR).NE.0.0)
LFISD=LFISD.OR.(CHD(IBM,IFIS,IGR,1).NE.0.0)
50 CONTINUE
51 CONTINUE
52 CONTINUE
*
DO 85 IGR=1,NGR
KPMAC=LCMGIL(JPMAC,IGR)
*----
* PROCESS FISSION NUSIGF TERMS.
*----
IF(LFIS) THEN
CALL LCMLEN(KPMAC,'NUSIGF',LENGT,ITYLCM)
IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH FO'
1 //'R NUSIGF INFORMATION.')
IF(LENGT.GT.0) CALL LCMGET(KPMAC,'NUSIGF',SGF(1,1,IGR))
ENDIF
IF(LNUD) THEN
DO 62 IDEL=1,NDG
DO 61 IFIS=1,NBFIS
DO 60 IBM=1,NBM
SGD(IBM,IFIS,IGR,IDEL)=SGF(IBM,IFIS,IGR)*DNF(IDEL)
60 CONTINUE
61 CONTINUE
62 CONTINUE
ELSE IF(LFISD) THEN
DO 70 IDEL=1,NDG
WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYLCM)
IF(LENGT.NE.NBM*NBFIS) CALL XABORT('@KINXSD: INVALID LENGTH FO'
1 //'R DELAYED NUSIGF INFORMATION.')
IF(LENGT.GT.0) CALL LCMGET(KPMAC,TEXT12,SGD(1,1,IGR,IDEL))
70 CONTINUE
ENDIF
*----
* PROCESS 1/V TERMS.
*----
CALL LCMLEN(KPMAC,'OVERV',LENGT,ITYLCM)
IF(LENGT.EQ.NBM)THEN
CALL LCMGET(KPMAC,'OVERV',OVR(1,IGR))
ELSEIF(LENGT.EQ.0)THEN
CALL XABORT('@KINXSD: MISSING OVERV DATA.')
ELSE
CALL XABORT('@KINXSD: INVALID OVERV DATA.')
ENDIF
DO 80 IBM=1,NBM
OVR(IBM,IGR)=OVR(IBM,IGR)/DT
80 CONTINUE
85 CONTINUE
*
DO 93 IGR=1,NGR
DO 92 IFIS=1,NBFIS
DO 91 IBM=1,NBM
SGF(IBM,IFIS,IGR)=SGF(IBM,IFIS,IGR)/EVL
DO 90 IDEL=1,NDG
SGD(IBM,IFIS,IGR,IDEL)=SGD(IBM,IFIS,IGR,IDEL)/EVL
90 CONTINUE
91 CONTINUE
92 CONTINUE
93 CONTINUE
RETURN
END
|
