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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
*DECK CREXSI
SUBROUTINE CREXSI(IPMAP,NENTRY,HENTRY,KENTRY,NMIX,NGRP,NL,ILEAK,
1 IMPX,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,IJJ,NJJ,SCAT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover and/or interpolate l_compo data.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s):
* A. Hebert, D. Sekki
*
*Parameters: input
* IPMAP pointer to the fuel-map information.
* NENTRY number of lcm or xsm objects used by the module.
* HENTRY character*12 name of each lcm or xsm objects.
* KENTRY pointers to the lcm or xsm objects.
* NMIX maximum number of material mixtures.
* NGRP number of energy groups.
* NL number of legendre orders (=1 for isotropic scattering).
* ILEAK diffusion coefficient flag (=1: isotropic; =2: anisotropic).
* IMPX printing index (=0 for no print).
*
*Parameters: output
* TOTAL total macroscopic x-sections.
* ZNUG nu*fission macroscopic x-sections.
* SNUGF fission macroscopic x-sections.
* CHI fission spectrum.
* OVERV reciprocal neutron velocities.
* DIFFX x-directed diffusion coefficients.
* DIFFY y-directed diffusion coefficients.
* DIFFZ z-directed diffusion coefficients.
* H h-factors (kappa*fission macroscopic x-sections).
* IJJ profile storage index.
* NJJ profile storage width.
* SCAT scattering macroscopic x-sections.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NENTRY,NMIX,NGRP,NL,ILEAK,IMPX,IJJ(NMIX,NL,NGRP),
1 NJJ(NMIX,NL,NGRP)
TYPE(C_PTR) IPMAP,KENTRY(NENTRY)
CHARACTER HENTRY(NENTRY)*12
REAL TOTAL(NMIX,NGRP),ZNUG(NMIX,NGRP),SNUGF(NMIX,NGRP),
1 CHI(NMIX,NGRP),OVERV(NMIX,NGRP),DIFFX(NMIX,NGRP),
2 DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),H(NMIX,NGRP),
3 SCAT(NMIX,NL,NGRP,NGRP)
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) IPCPO,JPCPO,JPMAP,KPMAP
PARAMETER(NSTATE=40,IOUT=6)
CHARACTER TEXT*12,NAMDIR*12,HCOMPO*12,HSMG*131
INTEGER IPAR(NSTATE),IDATA(NSTATE)
LOGICAL DERIV,UPS,LTAB
DOUBLE PRECISION DFLOT
REAL, ALLOCATABLE, DIMENSION(:) :: YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,
1 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX
INTEGER, ALLOCATABLE, DIMENSION(:) :: HISO,ITY,FMIX
REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BURNU,BRN0,BRN1
*
IVARTY=0
UPS=.FALSE.
LTAB=.FALSE.
DERIV=.FALSE.
NFUEL=0
MAXEN=NENTRY
IF(C_ASSOCIATED(IPMAP))THEN
CALL LCMGET(IPMAP,'STATE-VECTOR',IDATA)
IF(IDATA(4).NE.NGRP)CALL XABORT('@CREXSI: DIFFERENT NUM'
1 //'BER OF ENERGY GROUPS IN COMPO AND FUEL MAP.')
NB=IDATA(1)
NCH=IDATA(2)
NFUEL=IDATA(7)
MAXEN=MAXEN-1
LTAB=.TRUE.
ENDIF
*----
* READ INTERPOLATION OPTION
*----
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
DO 200 IEN=2,MAXEN
* KEYWORD COMPO OR TABLE
IF(TEXT.EQ.'COMPO')THEN
IF(C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: ONLY USE '
1 //'OF EITHER COMPO OR TABLE OPTION. BOTH OPTIONS ARE '
2 //'NOT ALLOWED.')
ELSEIF(TEXT.EQ.'TABLE')THEN
IF(.NOT.C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: MISS'
1 //'ING FUEL MAP.')
ELSE
CALL XABORT('@CREXSI: KEYWORD COMPO OR TABLE EXPECTED.')
ENDIF
* COMPO NAME
CALL REDGET(ITYP,NITMA,FLOT,HCOMPO,DFLOT)
IF(ITYP.NE.3)CALL XABORT('@CREXSI: COMPO NAME EXPECTED.')
DO JEN=2,MAXEN
IF(HCOMPO.EQ.HENTRY(JEN))THEN
IPCPO=KENTRY(JEN)
IF(IMPX.GT.1)CALL LCMLIB(IPCPO)
GOTO 10
ENDIF
ENDDO
WRITE(HSMG,'(44HCREXSI: UNABLE TO FIND THE COMPO WITH NAME '',
1 A12,2H''.)') TEXT
CALL XABORT(HSMG)
*----
* READ MIX INFO
*----
10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF(TEXT.NE.'MIX')CALL XABORT('@CREXSI: KEYWORD MIX EXPECTED.')
CALL LCMGET(IPCPO,'STATE-VECTOR',IPAR)
NGRP1=IPAR(2)
NL1=IPAR(4)
NISO=IPAR(3)
IF(NGRP1.NE.NGRP)THEN
WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF GROUPS. IN MACRO,
1 5HLIB =,I5,11H IN COMPO =,I5)') NGRP,NGRP1
CALL XABORT(HSMG)
ENDIF
IF(NL1.LT.NL)THEN
WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF LEGENDRE ORDERS.,
1 14H IN MACROLIB =,I5,11H IN COMPO =,I5)') NL,NL1
CALL XABORT(HSMG)
ENDIF
20 ALLOCATE(HISO(3*NISO),ITY(NISO),CONC(NISO))
CALL CREXSR(IPCPO,LTAB,HCOMPO,NMIX,IMPX,NISO,IBM,DERIV,UPS,
1 NAMDIR,NISO1,HISO,ITY,CONC,NBURN,KBURN,IVARTY,
2 IBTYP,BURN0,BURN1)
JPCPO=LCMGID(IPCPO,NAMDIR)
*----
* TABLE-OPTION INTERPOLATION
*----
IF(LTAB)THEN
* CHECK FUEL MIXTURE
JPMAP=LCMGID(IPMAP,'FUEL')
DO 30 IFUEL=1,NFUEL
KPMAP=LCMGIL(JPMAP,IFUEL)
CALL LCMGET(KPMAP,'MIX',IMIX)
IF(IMIX.EQ.IBM)GOTO 40
CALL LCMLEN(KPMAP,'MIX-VOID',LENGT,ITYP)
IF(LENGT.EQ.0)GOTO 30
CALL LCMGET(KPMAP,'MIX-VOID',IMIX)
IF(IMIX.EQ.IBM)GOTO 40
30 CONTINUE
WRITE(IOUT,*)'@CREXSI: UNABLE TO FIND FUEL MIXTURE ',IBM
CALL XABORT('@CREXSI: WRONG MIXTURE NUMBER.')
*
40 ALLOCATE(BURNU(NBURN),BRN0(NCH*NB),BRN1(NCH*NB),FMIX(NCH*NB))
CALL CRERGR(JPCPO,IPMAP,NISO1,NGRP,NMIX,NL,IBM,IMPX,IBTYP,DERIV,
1 UPS,NBURN,BURNU,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,
2 DIFFZ,H,SCAT,IJJ,NJJ,HISO,ITY,CONC,FMIX,BRN0,BRN1,NCH,NB,IVARTY)
DEALLOCATE(FMIX,BRN1,BRN0,BURNU)
DEALLOCATE(CONC,ITY,HISO)
*----
* COMPO-OPTION INTERPOLATION
*----
ELSE
ALLOCATE(YTOTAL(NGRP),YZNUG(NGRP),YNUGF(NGRP),YCHI(NGRP),
1 YOVERV(NGRP),YDIFX(NGRP),YDIFY(NGRP),YDIFZ(NGRP),YH(NGRP),
2 YSCAT(NL*NGRP*NGRP),YFLUX(NGRP))
CALL CREINT(JPCPO,NISO1,DERIV,NBURN,KBURN,BURN0,BURN1,NGRP,
1 NL,IMPX,HISO,ITY,CONC,ILEAK,YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,
2 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX,UPS)
* DATA STORAGE.
DO 112 JGR=1,NGRP
TOTAL(IBM,JGR)=YTOTAL(JGR)
ZNUG(IBM,JGR)=YZNUG(JGR)
SNUGF(IBM,JGR)=YNUGF(JGR)
CHI(IBM,JGR)=YCHI(JGR)
OVERV(IBM,JGR)=YOVERV(JGR)
DIFFX(IBM,JGR)=YDIFX(JGR)
DIFFY(IBM,JGR)=YDIFY(JGR)
DIFFZ(IBM,JGR)=YDIFZ(JGR)
H(IBM,JGR)=YH(JGR)
DO 111 IGR=1,NGRP
DO 110 IL=1,NL
SCAT(IBM,IL,IGR,JGR)=YSCAT(NL*((JGR-1)*NGRP+IGR-1)+IL)
110 CONTINUE
111 CONTINUE
112 CONTINUE
DEALLOCATE(YFLUX,YSCAT,YH,YDIFZ,YDIFY,YDIFX,YOVERV,YCHI,YNUGF,
1 YZNUG,YTOTAL)
DEALLOCATE(CONC,ITY,HISO)
* JGR IS THE SECONDARY GROUP.
DO 135 JGR=1,NGRP
DO 130 IL=1,NL
IGMIN=JGR
IGMAX=JGR
DO IGR=NGRP,1,-1
IF(SCAT(IBM,IL,IGR,JGR).NE.0.)THEN
IGMIN=MIN(IGMIN,IGR)
IGMAX=MAX(IGMAX,IGR)
ENDIF
ENDDO
IJJ(IBM,IL,JGR)=IGMAX
NJJ(IBM,IL,JGR)=IGMAX-IGMIN+1
130 CONTINUE
135 CONTINUE
ENDIF
CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
IF(TEXT.EQ.'MIX')GOTO 20
200 CONTINUE
IF(TEXT.NE.';') CALL XABORT('@CREXSI: FINAL ; EXPECTED.')
RETURN
END
|
