summaryrefslogtreecommitdiff
path: root/Donjon/src/CREBUR.f
blob: a46ba15bd420fb802410c7ae47c29302f626430e (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
*DECK CREBUR
      SUBROUTINE CREBUR(IPCPO,NISO,NGRP,NL,IMPX,HISO,DERIV,NBURN,BURN0,
     1 BURN1,BURNUP,ITY,CONC,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,
     2 DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Interpolate l_compo for a given burnup value.
*
*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    printing index (=0 for no print).
* HISO    hollerith name information for extracted isotopes.
* DERIV   =.true.: derivative of macrolib info is computed with
*         respect to burn1.
* NBURN   number of tabulated burnup steps.
* BURN0   user defined initial burnup.
* BURN1   user defined final burnup:
*          if burn0=burn1, a simple interpolation is performed;
*          if burn0<burn1, a time-average calculation is performed.
* BURNUP  burnup tabulation points.
* 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).
* 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.
* UPS
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPCPO
      INTEGER NISO,NGRP,NL,IMPX,NBURN,HISO(3*NISO),ITY(NISO),ILEAK
      REAL BURNUP(NBURN),CONC(NISO),TOTAL(NGRP),ZNUG(NGRP),
     1 CHI(NGRP),OVERV(NGRP),DIFFX(NGRP),DIFFY(NGRP),DIFFZ(NGRP),
     2 H(NGRP),SCAT(NL,NGRP,NGRP),SNUGF(NGRP),FLUX(NGRP),BURN0,BURN1
      LOGICAL DERIV,UPS
*----
*  LOCAL VARIABLES
*----
      LOGICAL LCUBIC
      PARAMETER(LCUBIC=.TRUE.)
      REAL, ALLOCATABLE, DIMENSION(:) :: TERP
      REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTOTAL,ZZNUG,ZNUGF,ZCHI,
     1 ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,ZFLUX
      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: ZSCAT
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(ZTOTAL(NBURN,NGRP),ZZNUG(NBURN,NGRP),ZNUGF(NBURN,NGRP),
     1 ZCHI(NBURN,NGRP),ZOVERV(NBURN,NGRP),ZDIFFX(NBURN,NGRP),
     2 ZDIFFY(NBURN,NGRP),ZDIFFZ(NBURN,NGRP),ZH(NBURN,NGRP),
     3 ZFLUX(NBURN,NGRP),ZSCAT(NBURN,NL,NGRP,NGRP),TERP(NBURN))
*----
*  RECOVER MACROSCOPIC X-SECTION INFO FROM BURNUP DIRECTORIES
*----
      IF(NBURN.LE.1)CALL XABORT('@CREBUR: NO BURNUP INFORMATION.')
      CALL CRETAB(IPCPO,NISO,NGRP,NL,IMPX,HISO,NBURN,ITY,CONC,ILEAK,
     1 ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,ZSCAT,
     2 ZFLUX,UPS)
*----
*  PERFORM INTERPOLATION OR TIME AVERAGING
*----
      IF(BURN0.LT.BURN1)THEN
*       TIME-AVERAGED
        CALL ALTERI(LCUBIC,NBURN,BURNUP,BURN0,BURN1,TERP)
        DO 100 I=1,NBURN
        TERP(I)=TERP(I)/(BURN1-BURN0)
  100   CONTINUE
      ELSE IF(BURN0.EQ.BURN1)THEN
*       INSTANTANEOUS
        CALL ALTERP(LCUBIC,NBURN,BURNUP,BURN0,DERIV,TERP)
      ELSE
        CALL XABORT('@CREBUR: ILLEGAL BURN1 VALUE.')
      ENDIF
      CALL CREITP(NGRP,NL,NBURN,TERP,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,
     1 DIFFY,DIFFZ,H,SCAT,FLUX,ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,
     2 ZDIFFY,ZDIFFZ,ZH,ZSCAT,ZFLUX)
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(TERP,ZFLUX,ZSCAT,ZH,ZDIFFZ,ZDIFFY,ZDIFFX,ZOVERV,ZCHI,
     1 ZNUGF,ZZNUG,ZTOTAL)
      RETURN
      END