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 EDIRAT
SUBROUTINE EDIRAT(IOPERA,NREGIO,NBMIX,MATCOD,FLXINT,AFLUX,RATES,
> SIGMAX,IMERGE,NMERGE)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Evaluate reaction rates from cross sections.
*
*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
* IOPERA type of action taken:
* = 2 add cross section (no flux);
* = 1 add reaction rates;
* = 0 evaluate integrated flux;
* =-1 subtract reaction rates.
* NREGIO number of regions.
* NBMIX number of mixtures.
* MATCOD material per region.
* FLXINT integrated fluxes.
* AFLUX adjoint fluxes.
* SIGMAX cross section array.
* IMERGE region merging matrix.
* NMERGE number of merged regions.
*
*Parameters: input/output
* RATES initial and final reaction rates.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER IOPERA,NREGIO,NBMIX,MATCOD(NREGIO),IMERGE(NREGIO),
> NMERGE
REAL FLXINT(NREGIO),AFLUX(NREGIO),RATES(NMERGE),
> SIGMAX(0:NBMIX)
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: DBRAT
*----
* SCRATCH STORAGE ALLOCATION
* DBRAT double-precision reaction rates.
*----
ALLOCATE(DBRAT(0:NMERGE))
*----
* INITIALIZE DOUBLE PRECISION REACTION RATES
*----
DO 90 IREG=0,NMERGE
DBRAT(IREG)=0.0D0
90 CONTINUE
IF(IOPERA.EQ.0) THEN
*----
* INTEGRATED FLUXES
*----
DO 100 IREG=1,NREGIO
IRATME=IMERGE(IREG)
DBRAT(IRATME)=DBRAT(IRATME)+DBLE(FLXINT(IREG))
100 CONTINUE
ELSE IF(IOPERA.EQ.1) THEN
*----
* SUM REACTION RATES
*----
DO 110 IREG=1,NREGIO
IRATME=IMERGE(IREG)
MATNUM=MATCOD(IREG)
DBRAT(IRATME)=DBRAT(IRATME)+DBLE(FLXINT(IREG))
> *DBLE(SIGMAX(MATNUM))
110 CONTINUE
ELSE IF(IOPERA.EQ.-1) THEN
*----
* SUBSTRACT REACTION RATES
*----
DO 120 IREG=1,NREGIO
IRATME=IMERGE(IREG)
MATNUM=MATCOD(IREG)
DBRAT(IRATME)=DBRAT(IRATME)-DBLE(FLXINT(IREG))
> *DBLE(SIGMAX(MATNUM))
120 CONTINUE
ELSE IF(IOPERA.EQ.2) THEN
*----
* ADD CROSS SECTIONS
*----
DO 130 IREG=1,NREGIO
IRATME=IMERGE(IREG)
MATNUM=MATCOD(IREG)
DBRAT(IRATME)=DBRAT(IRATME)+DBLE(SIGMAX(MATNUM))
130 CONTINUE
ELSE IF(IOPERA.EQ.10) THEN
*----
* INTEGRATED ADJOINT FLUXES
*----
DO 140 IREG=1,NREGIO
IRATME=IMERGE(IREG)
DBRAT(IRATME)=DBRAT(IRATME)+DBLE(FLXINT(IREG))
> *DBLE(AFLUX(IREG))
140 CONTINUE
ELSE IF(IOPERA.EQ.11) THEN
*----
* SUM ADJOINT-WEIGHTED REACTION RATES
*----
DO 150 IREG=1,NREGIO
IRATME=IMERGE(IREG)
MATNUM=MATCOD(IREG)
DBRAT(IRATME)=DBRAT(IRATME)+DBLE(FLXINT(IREG))
> *DBLE(AFLUX(IREG))*DBLE(SIGMAX(MATNUM))
150 CONTINUE
ELSE IF(IOPERA.EQ.-11) THEN
*----
* SUBSTRACT ADJOINT-WEIGHTED REACTION RATES
*----
DO 160 IREG=1,NREGIO
IRATME=IMERGE(IREG)
MATNUM=MATCOD(IREG)
DBRAT(IRATME)=DBRAT(IRATME)-DBLE(FLXINT(IREG))
> *DBLE(AFLUX(IREG))*DBLE(SIGMAX(MATNUM))
160 CONTINUE
ENDIF
*----
* STORE DOUBLE PRECISION REACTION RATES IN SINGLE PRECISION VECTOR
*----
DO 170 IREG=1,NMERGE
RATES(IREG)=RATES(IREG)+REAL(DBRAT(IREG))
170 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(DBRAT)
RETURN
END
|