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
|
*DECK CRETAB
SUBROUTINE CRETAB(IPCPO,NISO,NGRP,NL,IMPX,HISO,NBURN,ITY,CONC,
1 ILEAK,ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,
3 ZSCAT,ZFLUX,UPS)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Create burnup dependent table with the extracted isotope.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s):
* A. Hebert
*
*Parameters: input
* IPCPO pointer to l_compo information.
* NISO 1+number of extracted isotopes.
* NGRP number of energy groups.
* NL number of legendre orders (=1 for isotropic scattering).
* IMPX print parameter (=0 for no print).
* HISO hollerith name information for extracted isotopes.
* NBURN number of tabulated burnup steps
* ITY =0: do not process the isotope; =1: use number density
* stored in conc(i); =2: use number density stored in compo.
* CONC user defined number density.
*
*Parameters: output
* ILEAK diffusion coefficient flag (=1: isotropic; =2: anisotropic).
* ZTOTAL burnup dependent total macroscopic x-sections
* ZZNUG burnup dependent nu*fission macroscopic x-sections.
* ZNUGF burnup dependent fission macroscopic x-sections.
* ZCHI burnup dependent fission spectrum.
* ZOVERV burnup dependent reciprocal neutron velocities.
* ZDIFFX burnup dependent x-directed diffusion coefficients.
* ZDIFFY burnup dependent y-directed diffusion coefficients.
* ZDIFFZ burnup dependent z-directed diffusion coefficients.
* ZH burnup dependent h-factors (kappa*fission macroscopic
* x-sections).
* ZSCAT burnup dependent scattering macroscopic x-sections.
* ZFLUX burnup dependent integrated flux.
*
*Parameters: scratch
* TOTAL total macroscopic x-sections.
* ZNUG nu*fission macroscopic x-sections.
* SNUGF fission macroscopic x-sections.
* CHI fission spectrum.
* OVERV reciprocal neutron velocities.
* DIFFX x-directed diffusion coefficients.
* DIFFY y-directed diffusion coefficients.
* DIFFZ z-directed diffusion coefficients.
* H h-factors (kappa*fission macroscopic x-sections).
* SCAT scattering macroscopic x-sections.
* FLUX integrated flux.
* DENSIT isotopic number densities.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPCPO
INTEGER NISO,NGRP,NL,IMPX,NBURN,HISO(3*NISO),ITY(NISO),ILEAK
REAL CONC(NISO),ZTOTAL(NBURN,NGRP),ZZNUG(NBURN,NGRP),
1 ZCHI(NBURN,NGRP),ZOVERV(NBURN,NGRP),ZDIFFX(NBURN,NGRP),
2 ZDIFFY(NBURN,NGRP),ZDIFFZ(NBURN,NGRP),ZH(NBURN,NGRP),
3 ZSCAT(NBURN,NL,NGRP,NGRP),ZNUGF(NBURN,NGRP),ZFLUX(NBURN,NGRP)
LOGICAL UPS
*----
* LOCAL VARIABLES
*----
CHARACTER TEXT12*12
REAL, ALLOCATABLE, DIMENSION(:) :: TOTAL,ZNUG,CHI,OVERV,DIFFX,
1 DIFFY,DIFFZ,H,SNUGF,FLUX,DENSIT
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(TOTAL(NGRP),ZNUG(NGRP),CHI(NGRP),OVERV(NGRP),DIFFX(NGRP),
1 DIFFY(NGRP),DIFFZ(NGRP),H(NGRP),SCAT(NL,NGRP,NGRP),SNUGF(NGRP),
2 FLUX(NGRP),DENSIT(NISO))
*----
* RECOVER MACROSCOPIC X-SECTION INFO FROM BURNUP DIRECTORIES
*----
DO 20 IBURN=1,NBURN
WRITE(TEXT12,'(4HBURN,4X,I4)') IBURN
CALL LCMSIX(IPCPO,TEXT12,1)
CALL LCMGET(IPCPO,'ISOTOPESDENS',DENSIT)
IF(DENSIT(1).NE.1.)CALL XABORT('@CRETAB: DENSIT(1).NE.1.')
DO I=2,NISO
IF(ITY(I).EQ.0)THEN
DENSIT(I)=0.
ELSEIF(ITY(I).EQ.1)THEN
DENSIT(I)=CONC(I)
ELSEIF(ITY(I).NE.2)THEN
CALL XABORT('@CRETAB: INVALID VALUE OF ITY.')
ENDIF
ENDDO
CALL CREMAC(IPCPO,NISO,NGRP,NL,IMPX,HISO,DENSIT,ILEAK,TOTAL,
1 ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
CALL LCMSIX(IPCPO,' ',2)
DO 21 JGR=1,NGRP
ZTOTAL(IBURN,JGR)=TOTAL(JGR)
ZZNUG(IBURN,JGR)=ZNUG(JGR)
ZNUGF(IBURN,JGR)=SNUGF(JGR)
ZCHI(IBURN,JGR)=CHI(JGR)
ZOVERV(IBURN,JGR)=OVERV(JGR)
ZDIFFX(IBURN,JGR)=DIFFX(JGR)
ZDIFFY(IBURN,JGR)=DIFFY(JGR)
ZDIFFZ(IBURN,JGR)=DIFFZ(JGR)
ZH(IBURN,JGR)=H(JGR)
ZFLUX(IBURN,JGR)=FLUX(JGR)
DO 22 IGR=1,NGRP
DO 23 IL=1,NL
ZSCAT(IBURN,IL,IGR,JGR)=SCAT(IL,IGR,JGR)
23 CONTINUE
22 CONTINUE
21 CONTINUE
20 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(DENSIT,FLUX,SNUGF,SCAT,H,DIFFZ,DIFFY,DIFFX,OVERV,CHI,
1 ZNUG,TOTAL)
RETURN
END
|
