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
|
*DECK MACNXS
SUBROUTINE MACNXS(IPLIST,MAXFIS,NGROUP,NBMIX,NIFISS,NANISO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Normalization of macroscopic cross section information.
*
*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): G. Marleau
*
*Parameters: input
* IPLIST LCM pointer to the macrolib.
* MAXFIS set to max(1,NIFISS).
* NGROUP number of energy groups.
* NBMIX number of mixtures.
* NIFISS number of fissile isotopes.
* NANISO maximum Legendre order:
* =1 isotropic collision;
* =2 linearly anisotropic collision.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIST
INTEGER MAXFIS,NGROUP,NBMIX,NIFISS,NANISO
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPLIST,KPLIST
CHARACTER CANISO*2
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: INGSCT,IFGSCT
REAL, ALLOCATABLE, DIMENSION(:) :: XSWORK,XSWOR2
REAL, ALLOCATABLE, DIMENSION(:,:) :: CHWORK
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: SCWORK
*----
* SCRATCH STORAGE ALLOCATION
* INGSCT number of scattering group for cross sections.
* IFGSCT first scattering group for cross sections.
*----
ALLOCATE(INGSCT(NBMIX),IFGSCT(NBMIX))
ALLOCATE(XSWORK(NBMIX*NGROUP),XSWOR2(NBMIX*NIFISS),
> CHWORK(NBMIX,MAXFIS))
ALLOCATE(SCWORK(NBMIX,NANISO,NGROUP))
*
DO 100 IMIX=1,NBMIX
DO 110 IAN=1,NANISO
DO 120 IG=1,NGROUP
SCWORK(IMIX,IAN,IG)=0.0D0
120 CONTINUE
110 CONTINUE
DO 130 JFIS=1,NIFISS
CHWORK(IMIX,JFIS)=0.0
130 CONTINUE
100 CONTINUE
JPLIST=LCMGID(IPLIST,'GROUP')
DO 140 IGR=1,NGROUP
KPLIST=LCMGIL(JPLIST,IGR)
*----
* COMPUTE SUM OF FISSION SPECTRUM.
*----
CALL LCMLEN(KPLIST,'CHI',ILCMLN,ITYLCM)
IF(ILCMLN.GT.0) THEN
CALL LCMGET(KPLIST,'CHI',XSWOR2)
DO 150 IFISS=1,NIFISS
DO 160 IMAT=1,NBMIX
CHWORK(IMAT,IFISS)=CHWORK(IMAT,IFISS)
> +XSWOR2((IFISS-1)*NBMIX+IMAT)
160 CONTINUE
150 CONTINUE
ENDIF
*----
* SUM TRANSFER MATRICES OVER SECONDARY GROUPS.
*----
DO 170 IANIS=1,NANISO
WRITE(CANISO,'(I2.2)') IANIS-1
CALL LCMLEN(KPLIST,'NJJS'//CANISO,ILCMLN,ITYLCM)
IF(ILCMLN.GT.0) THEN
CALL LCMGET(KPLIST,'NJJS'//CANISO,INGSCT)
CALL LCMGET(KPLIST,'IJJS'//CANISO,IFGSCT)
CALL LCMGET(KPLIST,'SCAT'//CANISO,XSWORK)
IPO=0
DO 180 IMAT=1,NBMIX
IDG=IFGSCT(IMAT)
IFG=IDG-INGSCT(IMAT)+1
DO 190 JGR=IDG,IFG,-1
IPO=IPO+1
SCWORK(IMAT,IANIS,JGR)=SCWORK(IMAT,IANIS,JGR)
> +XSWORK(IPO)
190 CONTINUE
180 CONTINUE
ENDIF
170 CONTINUE
140 CONTINUE
*----
* WRITE NORMALIZED X-S ON THE MACROLIB.
*----
DO 200 IGR=1,NGROUP
KPLIST=LCMGIL(JPLIST,IGR)
CALL LCMLEN(KPLIST,'CHI',ILCMLN,ITYLCM)
IF(ILCMLN.GT.0) THEN
CALL LCMGET(KPLIST,'CHI',XSWOR2)
DO 210 IFISS=1,NIFISS
DO 220 IMAT=1,NBMIX
IF(CHWORK(IMAT,IFISS).GT.0.5) XSWOR2((IFISS-1)*NBMIX+IMAT)
> =XSWOR2((IFISS-1)*NBMIX+IMAT)/CHWORK(IMAT,IFISS)
220 CONTINUE
210 CONTINUE
CALL LCMPUT(KPLIST,'CHI',NBMIX*NIFISS,2,XSWOR2)
ENDIF
DO 230 IANIS=1,NANISO
WRITE(CANISO,'(I2.2)') IANIS-1
CALL LCMLEN(KPLIST,'SIGS'//CANISO,ILCMLN,ITYLCM)
IF(ILCMLN.GT.0) THEN
DO 240 IMAT=1,NBMIX
XSWORK(IMAT)=REAL(SCWORK(IMAT,IANIS,IGR))
240 CONTINUE
CALL LCMPUT(KPLIST,'SIGS'//CANISO,NBMIX,2,XSWORK)
ENDIF
230 CONTINUE
200 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(SCWORK)
DEALLOCATE(CHWORK,XSWOR2,XSWORK)
DEALLOCATE(IFGSCT,INGSCT)
RETURN
END
|
