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
|
*DECK XDRNRM
SUBROUTINE XDRNRM(NREGIO,NBMIX,MATCOD,VOLUME,XSSIGT,XSSIGW,
> PIJSYM,PIS)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Normalisation of the scattering-reduced cp matrix to force neutron
* conservation (no leakage).
*
*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): A. Hebert
*
*Parameters: input
* NREGIO number of regions considered.
* NBMIX number of mixtures.
* MATCOD mixture code in each region.
* VOLUME volume of each region.
* XSSIGT total macroscopic cross sections.
* XSSIGW P0 within-group scattering cross sections.
*
*Parameters: input/output
* PIJSYM group condensed reduce/symmetric scattering-reduced pij
* matrix.
* PIS escape probabilities.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NREGIO,NBMIX,MATCOD(NREGIO)
REAL VOLUME(NREGIO),XSSIGT(NBMIX),XSSIGW(NBMIX),
> PIJSYM(NREGIO*(NREGIO+1)/2),PIS(NREGIO)
*----
* LOCAL VARIABLES
*----
DOUBLE PRECISION SUM,DD
*----
* INTRINSIC FUNCTION FOR POSITION IN CONDENSED PIJ MATRIX
*----
INDPOS(I,J)=MAX(I,J)*(MAX(I,J)-1)/2+MIN(I,J)
*
DD=0.0D0
DO 20 I=1,NREGIO
SUM=0.0D0
DO 10 J=1,NREGIO
MATNUM=MATCOD(J)
IF(MATNUM.GT.0) THEN
SUM=SUM+(XSSIGT(MATNUM)-XSSIGW(MATNUM))*PIJSYM(INDPOS(I,J))/
1 VOLUME(I)
ENDIF
10 CONTINUE
PIS(I)=REAL(1.0D0-SUM)
MATNUM=MATCOD(I)
IF(MATNUM.GT.0) THEN
DD=DD+(XSSIGT(MATNUM)-XSSIGW(MATNUM))*VOLUME(I)*PIS(I)
ENDIF
20 CONTINUE
IF(DD.EQ.0.0D0) RETURN
DO 40 I=1,NREGIO
DO 30 J=1,I
INDPIJ=INDPOS(I,J)
PIJSYM(INDPIJ)=PIJSYM(INDPIJ)+PIS(I)*PIS(J)*VOLUME(I)*VOLUME(J)/
> REAL(DD)
30 CONTINUE
40 CONTINUE
RETURN
END
|
