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
|
*DECK MCGFCR
SUBROUTINE MCGFCR(IPRINT,IG,II,NG,NGEFF,KPN,N,NREG,NANI,NFUNL,M,
1 LTYPE,KEYFLX,KEYCUR,NZON,NGINDV,REBAL,FI,FIOLD,
2 SC,TAB,NJJ,IJJ,IPOS,XSCAT,AR)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compute residual of a previous free iterations for ACA method.
*
*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): R. Le Tellier
*
*Parameters: input
* IPRINT print parameter (equal to zero for no print).
* IG index of group to process in "NG format".
* II index of group to process in "NGEFF format".
* NG number of groups.
* NGEFF number of groups to process.
* KPN total number of unknowns in vectors SUNKNO and FUNKNO.
* N total number of volumes for which specific values
* of the neutron flux and reactions rates are required.
* NREG number of volumes.
* NANI scattering anisotropy (=1 for isotropic scattering).
* NFUNL number of moments of the flux (in 2D : NFUNL=NANI*(NANI+1)/2).
* M number of material mixtures.
* LTYPE flag to know how the residual vector is organized:
* .TRUE. for ACA, with permutation array, only the isotropic
* moments;
* .FALSE. for SCR, without permutation array, all the moments.
* KEYFLX position of flux elements in FI vector.
* KEYCUR position of current elements in FI vector.
* NZON index-number of the mixture type assigned to each volume.
* NGINDV index to pass from "NGEFF format" to "NG format"
* REBAL type of acceleration (.TRUE. rebalancing ; .FALSE.
* inner iterations acceleration).
* FI zonal scalar flux.
* SC macroscopic "in group" scattering cross section.
* FIOLD old zonal scalar flux.
* TAB if LTYPE, IPERM(N) permutation array,
* otherwise, KEYANI(NFUNL) 'mode to l' index: l=KEYANI(nu).
* NJJ scattering information.
* IJJ scattering information.
* IPOS scattering information.
* XSCAT scattering information.
*
*Parameters: output
* AR residual form previous free iteration.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER IPRINT,IG,II,NG,NGEFF,KPN,N,NREG,NANI,NFUNL,M,
1 KEYFLX(NREG,NFUNL),KEYCUR(*),TAB(*),NZON(N),NGINDV(NG),
2 NJJ(0:M),IJJ(0:M),IPOS(0:M)
REAL FIOLD(KPN,NGEFF),SC(0:M,NANI),XSCAT(0:M*NG)
DOUBLE PRECISION AR(*),FI(KPN,NGEFF)
LOGICAL REBAL,LTYPE
*
IF(IPRINT.GT.99) WRITE(6,'(23H MCGFCR: PROCESS GROUPS,2I6)') IG,II
*
IF (LTYPE) THEN
*---
* ACA RESIDUAL
*---
DO I=1,N
J=TAB(I)
IBM=NZON(J)
IF(IBM.GE.0) THEN
SIGC=SC(IBM,1)
IND=KEYFLX(J,1)
ELSE
SIGC=0.5
IND=KEYCUR(J-NREG)
ENDIF
AR(I)=(FI(IND,II)-FIOLD(IND,II))*SIGC
IF ((REBAL).AND.(IBM.GT.0)) THEN
* rebalancing option on : contribution from other groups.
JG=IJJ(IBM)
DO 10 JND=1,NJJ(IBM)
IF(JG.NE.IG) THEN
JJ=NGINDV(JG)
IF (JJ.GT.0) THEN
AR(I)=AR(I)+XSCAT(IPOS(IBM)+JND-1)*
1 (FI(IND,JJ)-FIOLD(IND,JJ))
ENDIF
ENDIF
JG=JG-1
10 CONTINUE
ENDIF
ENDDO
ELSE
*---
* SCR RESIDUAL
*---
DO I=1,N
IBM=NZON(I)
IF(IBM.GE.0) THEN
DO INU=1,NFUNL
IND=KEYFLX(I,INU)
IL=TAB(INU)
SIGC=REAL(2*IL+1)*SC(IBM,IL+1)
AR(IND)=(FI(IND,II)-FIOLD(IND,II))*SIGC
ENDDO
ELSE
SIGC=0.5
IND=KEYCUR(I-NREG)
AR(IND)=(FI(IND,II)-FIOLD(IND,II))*SIGC
ENDIF
IF ((REBAL).AND.(IBM.GT.0)) THEN
* rebalancing option on: contribution from other groups.
IND=KEYFLX(I,1)
JG=IJJ(IBM)
DO 20 JND=1,NJJ(IBM)
IF(JG.NE.IG) THEN
JJ=NGINDV(JG)
IF (JJ.GT.0) THEN
AR(IND)=AR(IND)+XSCAT(IPOS(IBM)+JND-1)*
1 (FI(IND,JJ)-FIOLD(IND,JJ))
ENDIF
ENDIF
JG=JG-1
20 CONTINUE
ENDIF
ENDDO
ENDIF
RETURN
END
|