summaryrefslogtreecommitdiff
path: root/Dragon/src/MCGFCR.f
blob: 4503da9829b0aa8c817ea124b73051771a6dce4e (plain)
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