summaryrefslogtreecommitdiff
path: root/Donjon/src/HSTUBH.f
blob: a7b7bad215f3b9571b6135e55fbf26478527c0c4 (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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
*DECK HSTUBH                                 
      SUBROUTINE HSTUBH(IPEVO,  IPHST,  IPRINT, MAXI,   NBBTS,   NCHA,
     >                  NBUN,   IUPDC,  IUPDB,  IDCELL, IDFUEL,  DENI)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To update the BURNUP data structure using the information
* provided on the HISTORY data structure.
*
*Copyright:
* Copyright (C) 2003 Ecole Polytechnique de Montreal.
*
*Author(s): 
* G. Marleau
*
*Parameters: input
* IPEVO   address of the \dds{burnup} data structure.
* IPHST   address of the \dds{history} data structure.
* IPRINT  print level.
* MAXI    maximum number of isotopes.            
* NBBTS   number of depletion steps.
* NCHA    number of fuel channels.                   
* NBUN    number of bundles per channel.
* IUPDC   number of the channel to analyze.                   
* IUPDB   number of the bundle to analyze.
* IDCELL  cell identifier for each fuel bundle in each channel.
* IDFUEL  fuel type identifier for each fuel bundle in each channel.
*
*Parameters: output
* NAMIH   name of isotopes on the \dds{history} 
*         or \dds{burnup} structure.
* MIXIH   mixture number associated with the isotopes 
*         on the \dds{history} or \dds{burnup} structure.
* DENI    isotopic concentrations of the isotopes 
*         on the \dds{history} or \dds{burnup} structure.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
      IMPLICIT         NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR)      IPHST,IPEVO
      INTEGER          IPRINT,MAXI,NBBTS
      INTEGER          NCHA,NBUN,IUPDC,IUPDB
      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
      REAL             DENI(0:MAXI) 
*----
*  LOCAL PARAMETERS
*  CDAY = conversion of days in 10^{8} seconds
*----
      INTEGER          IOUT
      INTEGER          ILCMUP,ILCMDN
      CHARACTER        NAMSBR*6
      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUBH')
      REAL             CDAY
      PARAMETER       (CDAY=8.64E-4)
*----
*  LOCAL VARIABLES
*---- 
      INTEGER          ILCMLN,ILCMTY 
      CHARACTER        NAMTIM*12,NAMP*12 
      INTEGER          IFT,ICT
      INTEGER          ITS,ISO,IOK
      REAL             BITH(3)
      REAL             FDENC(2)
      REAL             FLXNOR,DELTA(2)
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXIH
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMIH
      REAL, ALLOCATABLE, DIMENSION(:) :: DEPLT
*----
*  SCRATCH STORAGE ALLOCATION
*   NAMIH   name of isotopes on the \dds{history} structure.
*   MIXIH   mixture number associated with the isotopes 
*           on the \dds{history} structure.
*   DEPLT   time associated with each depletion step 
*           on the \dds{burnup} structure.
*----
      ALLOCATE(NAMIH(3,0:MAXI),MIXIH(0:MAXI),DEPLT(0:NBBTS))
*----
*  Read HISTORY information for cell specified
*  1) Read fuel type information
*----
      IF(IPRINT .GE. 100) THEN
        WRITE(IOUT,6000) NAMSBR
      ENDIF
      IFT=IDFUEL(IUPDB,IUPDC)
      WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT 
      CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
      IF(ILCMLN .EQ. 0) CALL XABORT(NAMSBR//
     >':/ Fuel type absent -- BURNUP creation impossible')
      CALL LCMSIX(IPHST,NAMP,ILCMUP)
      CALL LCMLEN(IPHST,'ISOTOPESUSED',ILCMLN,ILCMTY)
      IF(ILCMLN .GT. 0 .AND. ILCMLN .LT. 3*MAXI*4) THEN
        CALL LCMGET(IPHST,'ISOTOPESUSED',NAMIH(1,1)) 
        CALL LCMGET(IPHST,'ISOTOPESMIX',MIXIH(1))
      ELSE
        CALL XABORT(NAMSBR//
     >  ':/ Isotopes are absent -- BURNUP creation impossible')
      ENDIF
      CALL LCMSIX(IPHST,NAMP,ILCMDN)
      IF(IPRINT .GE. 100) THEN
        WRITE(IOUT,6001) 'FUEL TYPE',IFT
        IF(IPRINT .GE. 100) THEN
          WRITE(IOUT,6010) 
          WRITE(IOUT,6011) 
     >    (NAMIH(1,ISO),NAMIH(2,ISO),NAMIH(3,ISO),ISO=1,MAXI)
          WRITE(IOUT,6020) 
          WRITE(IOUT,6021) 
     >    (MIXIH(ISO),ISO=1,MAXI)
        ENDIF
      ENDIF 
*----
*  2) Real cell type information
*----
      ICT=IDCELL(IUPDB,IUPDC)
      WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
      CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
      IF(ILCMLN .EQ. 0) CALL XABORT(NAMSBR//
     >':/ Cell type absent -- BURNUP creation impossible')
      CALL LCMSIX(IPHST,NAMP,ILCMUP)
      IOK=-1
      CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDENC )
      IF(IOK .NE. 0) CALL XABORT(NAMSBR//
     >':/ Densities are absent -- BURNUP creation impossible')
      CALL LCMGET(IPHST,'DEPL-PARAM  ',BITH)
      CALL LCMSIX(IPHST,NAMP,ILCMDN)
      IF(IPRINT .GE. 100) THEN
        WRITE(IOUT,6001) 'CELL TYPE',ICT
        IF(IPRINT .GE. 100) THEN
          WRITE(IOUT,6100)  
          WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI)
        ENDIF
      ENDIF
*----
*  Save isotopes names and mixtures on BURNUP
*----
      CALL LCMPUT(IPEVO,'ISOTOPESUSED',3*MAXI,3,NAMIH(1,1))
      CALL LCMPUT(IPEVO,'ISOTOPESMIX ',MAXI  ,1,MIXIH(1))
      CALL LCMPUT(IPEVO,'FUELDEN-INIT',2     ,2,FDENC)
*----
*  Save current burnup information as initial time step
*----
      FLXNOR=0.0
      DELTA(1)=0.0
      DELTA(2)=0.0
      ITS=0 
      DEPLT(ITS)=BITH(1)*CDAY
      CALL LCMPUT(IPEVO,'DEPL-TIMES  ',1     ,2,DEPLT(ITS))
      WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS+1
      CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
      CALL LCMPUT(IPEVO,'ISOTOPESDENS',MAXI,2,DENI(1))
      CALL LCMPUT(IPEVO,'FLUX-NORM   ',   1,2,FLXNOR)
      CALL LCMPUT(IPEVO,'DELTA       ',   2,2,DELTA)
      CALL LCMPUT(IPEVO,'BURNUP-IRRAD',   2,2,BITH(2))
      CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(DEPLT,MIXIH,NAMIH)
*----
*  Return
*----
      RETURN
*----
*  FORMAT
*----
 6000 FORMAT(' ****** OUTPUT FROM ',A6)
 6001 FORMAT(' Contents of ',A9,1X,I8) 
 6010 FORMAT(' NAME OF ISOTOPES ')
 6011 FORMAT(10(3A4,2X))
 6020 FORMAT(' MIXTURE OF ISOTOPES ')
 6021 FORMAT(10(I12,2X))
 6100 FORMAT(' INITIAL DENSITIES')
 6110 FORMAT(1P,10E14.7)
      END