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
|
*DECK QIJCMP
SUBROUTINE QIJCMP(NREG,NSOUT,NPIJ,NGRP,NCOR,VOLSUR,SIGTAL,DPR,
> NPSYS)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compression of PIJ matrices in symmetric format.
*
*Copyright:
* Copyright (C) 1994 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. Roy
*
*Parameters: input
* NREG number of zones for geometry.
* NSOUT number of surfaces for geometry.
* NPIJ number of probabilities in one group.
* NGRP number of groups.
* NCOR maximum number of corners.
* VOLSUR volumes.
* SIGTAL materials and albedos.
* NPSYS non-converged energy group indices.
*
*Parameters: input/output
* DPR collision probabilities on input and
* compress probability matrix at output.
*
*Comments:
* Format of compress probability matrix
* NPLEN=(NREG+NSOUT+2)*(NREG+NSOUT+1)/2
* IND(I,J)=MAX(I+NSOUT+1,J+NSOUT+1)
* *(MAX(I+NSOUT+1,J+NSOUT+1)-1)/2
* +MIN(I+NSOUT+1,J+NSOUT+1)
* IS=-NSOUT,-1; JS=-NSOUT,IS; I=IND(IS,JS)
* PROB(I)=VOLSUR(IS)*PSS(IS,JS)
* IV=1,NREG; JS=-NSOUT,-1; I=IND(IV,JS)
* SIGT(IV).GT.0.0
* PROB(I)=SIGT(IV)*VOLSUR(IV)*PVS(IV,JS)
* SIGT(IV).EQ.0.0
* PROB(I)=VOLSUR(IV)*PVS(IV,JS)
* IV=1,NREG; JV=1,IV; I=IND(IV,JV)
* SIGT(IV).GT.0.0 AND SIGT(JV).GT.0.0
* PROB(I)=SIGT(IV)*SIGT(JV)*VOLSUR(IV)*PVV(IV,JV)
* SIGT(IV).GT.0.0 AND SIGT(JV).EQ.0.0
* PROB(I)=SIGT(IV)*VOLSUR(IV)*PVV(IV,JV)
* SIGT(IV).EQ.0.0 AND SIGT(JV).GT.0.0
* PROB(I)=SIGT(JV)*VOLSUR(IV)*PVV(IV,JV)
* SIGT(IV).EQ.0.0 AND SIGT(JV).EQ.0.0
* PROB(I)=VOLSUR(IV)*PVV(IV,JV)
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
INTEGER NREG,NSOUT,NPIJ,NGRP,NCOR,NPSYS(NGRP)
INTEGER IPR,IL,JL,IG,INDIJ
REAL VOLSUR(NSOUT:NREG),SIGTAL(NSOUT:NREG,NGRP),ZERO
DOUBLE PRECISION DPR(NPIJ,NGRP),ZCOR,ZCOR1,DZERO
PARAMETER ( ZERO=0.0, DZERO=0.0D0 )
C----
C SYMMETRIZE AND STORE IN PROB
C----
INDIJ= 0
DO 5 IL = 1, NREG-NSOUT+1
INDIJ= INDIJ + IL
DO 1 IG= 1, NGRP
IF(NPSYS(IG).NE.0)
> DPR(INDIJ,IG)= DPR(INDIJ,IG) + DPR(INDIJ,IG)
1 CONTINUE
5 CONTINUE
IF( NCOR.NE.1 )THEN
ZCOR1= 1.0D0/DBLE(NCOR)
ZCOR= 1.0D0/DBLE(NCOR*NCOR)
INDIJ= 0
DO 35 IL = NSOUT, NREG
IF( IL.GT.0 ) ZCOR= ZCOR1
DO 25 JL = NSOUT, IL
INDIJ= INDIJ + 1
IF( JL.GT.0 ) ZCOR= 1.0D0
DO 15 IG= 1, NGRP
IF(NPSYS(IG).NE.0)
> DPR(INDIJ,IG)= ZCOR * DPR(INDIJ,IG)
15 CONTINUE
25 CONTINUE
35 CONTINUE
ENDIF
IPR=-((1-NSOUT)*NSOUT)/2
DO 80 IL= NSOUT,-1
IPR= IPR+1
DO 70 IG= 1, NGRP
IF(NPSYS(IG).NE.0) DPR(IPR,IG)= DBLE(VOLSUR(IL))
70 CONTINUE
80 CONTINUE
IPR= IPR+1
DO 90 IG= 1, NGRP
DPR(IPR,IG)= DZERO
90 CONTINUE
DO 110 IL= 1,NREG
IPR= IPR-NSOUT+IL
DO 100 IG= 1, NGRP
IF(NPSYS(IG).EQ.0) GO TO 100
IF( SIGTAL(IL,IG).EQ.ZERO )THEN
DPR(IPR,IG)= DBLE(VOLSUR(IL))
ELSE
DPR(IPR,IG)= DBLE(VOLSUR(IL)*SIGTAL(IL,IG))
ENDIF
100 CONTINUE
110 CONTINUE
C
RETURN
END
|
