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
|
*DECK EDISTA
SUBROUTINE EDISTA(IPRINT,NMERGE,ITYPE,VOLMER,VOLREL,VOLTOT,
> FLXNEW,FLXOLD,RATNEW,RATOLD)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Print homogenized/condensed macroscopic cross sections statistics.
*
*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
* IPRINT print level;
* = 0 no print;
* = 1 print fluxes;
* = 2 1+print reaction rates;
* = 3 2+print homogenized cross sections.
* NMERGE number of regions.
* ITYPE type of statistics:
* = 1 flux relative errors;
* = 2 reaction rates relative errors;
* = 3 delta sigma.
* VOLMER current region merged volumes.
* VOLREL old volume/new volume.
* VOLTOT total old volume.
* FLXNEW new integrated flux.
* FLXOLD old integrated flux.
* RATNEW new homogenized cross sections.
* RATOLD old homogenized cross sections.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER IPRINT,NMERGE,ITYPE
REAL VOLMER(NMERGE),VOLREL,VOLTOT,FLXNEW(NMERGE),
> FLXOLD(NMERGE),RATNEW(NMERGE),RATOLD(NMERGE)
*----
* LOCAL VARIABLES
*----
PARAMETER (IUNOUT=6)
REAL, ALLOCATABLE, DIMENSION(:) :: VALERR
*----
* SCRATCH STORAGE ALLOCATION
* VALERR relative error or delta sigma.
*----
ALLOCATE(VALERR(NMERGE))
*
IF(IPRINT.GT.2) THEN
IF(ITYPE.NE.3) THEN
WRITE(IUNOUT,6000)
ELSE
WRITE(IUNOUT,6001)
ENDIF
ENDIF
EPSMAX=0.0
EPSAVG=0.0
RPSAVG=0.0
DO 100 IREG=1,NMERGE
IF(ITYPE.EQ.3) THEN
CURVAL=RATNEW(IREG)
OLDVAL=RATOLD(IREG)
VALERR(IREG)=CURVAL-OLDVAL
ELSE
IF(ITYPE.EQ.1) THEN
CURVAL=VOLREL*FLXNEW(IREG)
OLDVAL=FLXOLD(IREG)
ELSE IF(ITYPE.EQ.2) THEN
CURVAL=VOLREL*RATNEW(IREG)*FLXNEW(IREG)
OLDVAL=RATOLD(IREG)*FLXOLD(IREG)
ENDIF
IF(OLDVAL.NE.0.0) THEN
VALERR(IREG)=100.0*(CURVAL-OLDVAL)/OLDVAL
ELSE IF(CURVAL.NE.0.0) THEN
VALERR(IREG)=100.0*(CURVAL-OLDVAL)/CURVAL
ELSE
VALERR(IREG)=0.0
ENDIF
ENDIF
IF(IPRINT.GT.2) THEN
WRITE(IUNOUT,6002) IREG,CURVAL,OLDVAL,VALERR(IREG)
ENDIF
IF(ITYPE.NE.3) THEN
EPSMAX=MAX(EPSMAX,ABS(VALERR(IREG)))
EPSAVG=EPSAVG+ABS(VALERR(IREG))*VOLMER(IREG)*VOLREL
RPSAVG=RPSAVG+VALERR(IREG)*VALERR(IREG)
ENDIF
100 CONTINUE
IF(ITYPE.NE.3) THEN
IF(IPRINT.GE.2) THEN
WRITE(IUNOUT,6003)
WRITE(IUNOUT,6006) (VALERR(IREG),IREG=1,NMERGE)
ENDIF
EPSAVG=EPSAVG/VOLTOT
WRITE(IUNOUT,6005) EPSMAX,EPSAVG,SQRT(RPSAVG/NMERGE)
ELSE IF(IPRINT.GE.2) THEN
WRITE(IUNOUT,6004)
WRITE(IUNOUT,6006) (VALERR(IREG),IREG=1,NMERGE)
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(VALERR)
RETURN
*----
* FORMAT
*----
6000 FORMAT(
>4X,'REGION',13X,'CURRENT VALUE',10X,'REFERENCE',16X,' ERROR (%) ')
6001 FORMAT(
>4X,'REGION',13X,'CURRENT VALUE',10X,'REFERENCE',16X,'DELTA SIGMA')
6002 FORMAT(4X,I5,10X,1P,E14.4,8X,E14.4,8X,E14.4)
6003 FORMAT(' RELATIVE ERROR (NEW-OLD) ON FLUXES (%)')
6004 FORMAT(' DELTA SIGMA (NEW-OLD)')
6005 FORMAT(/4X,' MAXIMUM ERROR=',F8.2,' %'/
> 4X,'VOLUME WEIGHTED AVERAGE ERROR=',F8.2,' %'/
> 4X,' RMS ERROR=',F8.2,' %')
6006 FORMAT(1P,7(3X,E15.7))
END
|
