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
150
|
*DECK FPSOUT
SUBROUTINE FPSOUT(IPMAC,IPRINT,NG,NMIL,NFIS,ILEAKS,TEXT9,OUTG)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compute the leakage rate in each energy group
*
*Copyright:
* Copyright (C) 2019 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
* IPMAC pointer to the macrolib structure.
* IPRINT print parameter
* NG number of energy groups.
* NMIL number of material mixtures.
* NFIS number of fissile isotopes.
* ILEAKS type of leakage calculation =0: no leakage; =1: homogeneous
* leakage (Diffon).
* TEXT9 type of calculation ('REFERENCE' or 'MACRO').
*
*Parameters: output
* OUTG leakage rates.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMAC
INTEGER IPRINT,NG,NMIL,NFIS,ILEAKS
CHARACTER TEXT9*9
REAL OUTG(NG)
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPMAC,KPMAC
CHARACTER HSMG*131
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS
REAL, ALLOCATABLE, DIMENSION(:) :: GAR,WORK,DIFHOM,DIFF
REAL, ALLOCATABLE, DIMENSION(:,:) :: PHI,NUF
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CHI,RHS,LHS
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(PHI(NMIL,NG),RHS(NMIL,NG,NG),LHS(NMIL,NG,NG))
ALLOCATE(IJJ(NMIL),NJJ(NMIL),IPOS(NMIL),GAR(NMIL),WORK(NMIL*NG),
> CHI(NMIL,NFIS,NG),NUF(NMIL,NFIS),DIFHOM(NG),DIFF(NMIL))
*----
* COMPUTE THE ACTUAL AND REFERENCE REACTION RATE MATRICES
*----
CALL LCMGET(IPMAC,'K-EFFECTIVE',ZKEFF)
IF(IPRINT.GT.1) WRITE(6,120) TEXT9,ZKEFF
CALL LCMLEN(IPMAC,'B2 B1HOM',ILCMLN,ITYLCM)
IF(ILCMLN.EQ.1) THEN
CALL LCMGET(IPMAC,'B2 B1HOM',B2)
ELSE
B2=0.0
ENDIF
IF((ILEAKS.EQ.1).AND.(IPRINT.GT.1)) THEN
WRITE(6,'(/9H FPSOUT: ,A,4H B2=,1P,E12.4)') TEXT9,B2
ENDIF
RHS(:NMIL,:NG,:NG)=0.0
LHS(:NMIL,:NG,:NG)=0.0
JPMAC=LCMGID(IPMAC,'GROUP')
DO IG=1,NG
KPMAC=LCMGIL(JPMAC,IG)
CALL LCMGET(KPMAC,'CHI',CHI(1,1,IG))
CALL LCMLEN(KPMAC,'FLUX-INTG',ILG,ITYLCM)
IF(ILG.NE.NMIL) CALL XABORT('FPSOUT: MISSING REFERENCE FLUX.')
CALL LCMGET(KPMAC,'FLUX-INTG',PHI(1,IG))
ENDDO
DO IG=1,NG
KPMAC=LCMGIL(JPMAC,IG)
IF(ILEAKS.EQ.1) THEN
CALL LCMLEN(KPMAC,'DIFF',ILCMLN,ITYLCM)
IF(ILCMLN.GT.0) THEN
CALL LCMGET(KPMAC,'DIFF',DIFF)
ELSE
CALL LCMGET(IPMAC,'DIFHOMB1HOM',DIFHOM)
DO IBM=1,NMIL
DIFF(IBM)=DIFHOM(IG)
ENDDO
ENDIF
ELSE
DIFF(:NMIL)=0.0
ENDIF
CALL LCMGET(KPMAC,'NTOT0',GAR)
CALL LCMGET(KPMAC,'SCAT00',WORK)
CALL LCMGET(KPMAC,'NJJS00',NJJ)
CALL LCMGET(KPMAC,'IJJS00',IJJ)
CALL LCMGET(KPMAC,'IPOS00',IPOS)
DO IBM=1,NMIL
IPOSDE=IPOS(IBM)
DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
* IG <-- JG
RHS(IBM,IG,JG)=RHS(IBM,IG,JG)-WORK(IPOSDE)*PHI(IBM,JG)
IPOSDE=IPOSDE+1
ENDDO
RHS(IBM,IG,IG)=RHS(IBM,IG,IG)+(GAR(IBM)+B2*DIFF(IBM))*
> PHI(IBM,IG)
ENDDO
CALL LCMGET(KPMAC,'NUSIGF',NUF)
DO IBM=1,NMIL
DO IFIS=1,NFIS
DO JG=1,NG
LHS(IBM,JG,IG)=LHS(IBM,JG,IG)+CHI(IBM,IFIS,JG)*
> NUF(IBM,IFIS)*PHI(IBM,IG)
ENDDO
ENDDO
ENDDO
ENDDO
*----
* COMPUTE THE ACTUAL AND REFERENCE ABSORPTION AND FISSION RATES
*----
DO IG=1,NG
OUTG(IG)=0.0
DO IBM=1,NMIL
OUTG(IG)=OUTG(IG)+SUM(LHS(IBM,IG,:NG))/ZKEFF-
1 SUM(RHS(IBM,IG,:NG))
ENDDO
IF(OUTG(IG).LT.-1.0E-6) THEN
WRITE(HSMG,'(21HFPSOUT: INCONSISTENT ,A,17H LEAKAGE IN GROUP,
1 I4,7H. LEAK=,1P,E13.4)') TEXT9,IG,OUTG(IG)
CALL XABORT(HSMG)
ENDIF
IF(IPRINT.GT.1) WRITE(6,130) IG,TEXT9,OUTG(IG)
ENDDO
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(DIFF,DIFHOM,NUF,CHI,WORK,GAR,IPOS,NJJ,IJJ)
DEALLOCATE(LHS,RHS,PHI)
RETURN
*
120 FORMAT(/9H FPSOUT: ,A,33H EFFECTIVE MULTIPLICATION FACTOR=,1P,
1 E12.4)
130 FORMAT(/8H FPSOUT:,5X,6HGROUP=,I4,1X,A,9H LEAKAGE=,1P,E12.4)
END
|
