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
|
*DECK BIVAA
SUBROUTINE BIVAA(IPSYS,IPTRK,IMPX,NREG,NBMIX,NANI,NW,MAT,VOL,
1 SIGT0,SIGW0,DIFF)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Assembly of one-speed finite-difference or finite-element matrices
* for a discretization of the 2D diffusion equation.
*
*Copyright:
* Copyright (C) 2004 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
* IPSYS pointer to the system matrices.
* IPTRK pointer to the tracking (L_TRACK signature).
* IMPX print flag (equal to zero for no print).
* NREG total number of merged regions for which specific values
* of the neutron flux and reaction rates are required.
* NBMIX number of mixtures.
* NANI number of Legendre orders for the scattering cross sections.
* NW type of weighting for P1 cross section info (=0: P0 ; =1: P1).
* MAT index-number of the mixture type assigned to each volume.
* VOL volumes.
* SIGT0 P0 and P1 total macroscopic cross sections ordered by mixture.
* SIGW0 within-group scattering macroscopic cross section ordered
* by mixture.
* DIFF diffusion coefficients ordered by mixture.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPSYS,IPTRK
INTEGER IMPX,NREG,NBMIX,NANI,NW,MAT(NREG)
REAL VOL(NREG),SIGT0(0:NBMIX,NW+1),SIGW0(0:NBMIX,NANI),
1 DIFF(0:NBMIX)
*----
* LOCAL VARIABLES
*----
PARAMETER(NSTATE=40)
INTEGER JPAR(NSTATE),IGB(8)
LOGICAL LBIHET
CHARACTER NAMP*12,TEXT10*10
REAL, ALLOCATABLE, DIMENSION(:) :: GAMMA
REAL, ALLOCATABLE, DIMENSION(:,:) :: SGD
PARAMETER(TEXT10='A001001')
*----
* RECOVER BIVAC SPECIFIC TRACKING PARAMETERS.
*----
CALL LCMGET(IPTRK,'STATE-VECTOR',JPAR)
LBIHET=JPAR(40).NE.0
IF(LBIHET) THEN
CALL LCMSIX(IPTRK,'BIHET',1)
CALL LCMGET(IPTRK,'PARAM',IGB)
IF(NREG.NE.IGB(3)) CALL XABORT('BIVAA: INVALID VALUE OF NREG('
1 //'1).')
CALL LCMSIX(IPTRK,' ',2)
ELSE
IF(NREG.NE.JPAR(1)) CALL XABORT('BIVAA: INVALID VALUE OF NREG'
1 //'(2).')
ENDIF
NLF=JPAR(14)
ISCAT=ABS(JPAR(16))
*----
* RECOVER PHYSICAL ALBEDO FUNCTIONS.
*----
CALL LCMLEN(IPSYS,'ALBEDO-FU',NALBP,ITYLCM)
IF(NALBP.GT.0) THEN
ALLOCATE(GAMMA(NALBP))
CALL LCMGET(IPSYS,'ALBEDO-FU',GAMMA)
ENDIF
*----
* COMPUTE THE WITHIN-GROUP SYSTEM MATRICES (LEAKAGE AND REMOVAL).
*----
IF(NLF.EQ.0) THEN
*----
* ++++ DIFFUSION THEORY ++++
*----
IF(NANI.GT.1) THEN
CALL XABORT('BIVAA: SPN MACRO-CALCULATION EXPECTED(1).')
ENDIF
ALLOCATE(SGD(NBMIX,3))
DO 10 IBM=1,NBMIX
SGD(IBM,1)=DIFF(IBM)
SGD(IBM,2)=DIFF(IBM)
SGD(IBM,3)=SIGT0(IBM,1)-SIGW0(IBM,1)
10 CONTINUE
*----
* ASSEMBLING OF A SINGLE-GROUP SYSTEM MATRIX FOR BIVAC.
*----
CALL BIVASM(TEXT10,0,IPTRK,IPSYS,IMPX,NBMIX,NREG,NLF,3,NALBP,
1 MAT,VOL,GAMMA,SGD)
DEALLOCATE(SGD)
ELSE
*----
* ++++ PN OR SPN THEORY ++++
*----
IF(NLF.LT.2) THEN
CALL XABORT('BIVAA: PN OR SPN KEYWORD EXPECTED.')
ENDIF
NAN=MIN(ISCAT,NANI)+1
ALLOCATE(SGD(NBMIX,2*NAN))
DO 30 IL=0,NAN-1
DO 20 IBM=1,NBMIX
IF(IL.LE.NW) THEN
GARS=SIGT0(IBM,IL+1)
ELSE IF((NW.GE.1).AND.(MOD(IL,2).EQ.1)) THEN
GARS=SIGT0(IBM,2)
ELSE
GARS=SIGT0(IBM,1)
ENDIF
IF(IL.LE.NAN-2) GARS=GARS-SIGW0(IBM,IL+1)
SGD(IBM,IL+1)=GARS
IF(GARS.NE.0.0) THEN
SGD(IBM,NAN+IL+1)=1.0/GARS
ELSE
SGD(IBM,NAN+IL+1)=1.0E10
ENDIF
20 CONTINUE
WRITE(NAMP,'(4HSCAR,I2.2,6H001001)') IL
CALL LCMPUT(IPSYS,NAMP,NBMIX,2,SGD(1,NAN+IL+1))
WRITE(NAMP,'(4HSCAI,I2.2,6H001001)') IL
CALL LCMPUT(IPSYS,NAMP,NBMIX,2,SGD(1,NAN+IL+1))
30 CONTINUE
JPAR(:NSTATE)=0
JPAR(7)=NBMIX
JPAR(8)=NAN
CALL LCMPUT(IPSYS,'STATE-VECTOR',NSTATE,1,JPAR)
*----
* ASSEMBLING OF A SINGLE-GROUP SYSTEM MATRIX FOR BIVAC.
*----
CALL BIVASM(TEXT10,0,IPTRK,IPSYS,IMPX,NBMIX,NREG,NLF,2*NAN,
1 NALBP,MAT,VOL,GAMMA,SGD)
DEALLOCATE(SGD)
ENDIF
IF(NALBP.GT.0) DEALLOCATE(GAMMA)
IF(IMPX.GT.2) CALL LCMLIB(IPSYS)
IF(IMPX.GT.10) CALL LCMVAL(IPSYS,' ')
RETURN
END
|
