summaryrefslogtreecommitdiff
path: root/Dragon/src/EDIRAT.f
blob: b96cd22c063ff1b64e18a49167526545f1c7d5c3 (plain)
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