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
|
*DECK COMCAL
SUBROUTINE COMCAL(IMPX,IPCPO,IPDEPL,IPEDIT,IPEDI2,LMACRO,LISO,
1 ITRES)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Store the results of an elementary calculation in the multicompo.
*
*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): A. Hebert
*
*Parameters: input
* IMPX print parameter.
* IPCPO pointer to the multicompo.
* IPDEPL pointer to the burnup object (L_BURNUP signature).
* IPEDIT pointer to the edition object (L_EDIT signature).
* IPEDI2 pointer to the edition object containing group form factor
* information (L_EDIT signature).
* LMACRO flag set to .TRUE. to recover cross sections from the
* macrolib.
* LISO =.true. if we want to register the region number of the
* isotopes.
*
*Parameters: output
* ITRES creation index for the macroscopic residual (=0: not created;
* =1: not a FP precursor; =2: is a FP precursor).
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER IMPX,ITRES
TYPE(C_PTR) IPCPO,IPDEPL,IPEDIT,IPEDI2
LOGICAL LMACRO,LISO
*----
* LOCAL VARIABLES
*----
PARAMETER (NSTATE=40,MAXISO=100)
TYPE(C_PTR) JPCPO,KPCPO,LPCPO
INTEGER ISTATE(NSTATE),IPAR(NSTATE)
REAL BIRRAD(2)
CHARACTER CDIRO*12,HSMG*131,NOMISP(MAXISO)*8
*
CALL LCMGTC(IPEDIT,'LAST-EDIT',12,CDIRO)
CALL LCMSIX(IPEDIT,CDIRO,1)
IF(LMACRO) THEN
CALL LCMSIX(IPEDIT,'MACROLIB',1)
CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
NMIL=IPAR(2)
NISOTS=1
NG=IPAR(1)
NED=IPAR(5)
NW=IPAR(10)
CALL LCMSIX(IPEDIT,' ',2)
ELSE
CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR)
NMIL=IPAR(1)
NISOTS=IPAR(2)
NG=IPAR(3)
NED=IPAR(13)
NW=IPAR(25)
ENDIF
CALL LCMSIX(IPEDIT,' ',2)
*
CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
IF(ISTATE(3).EQ.0) THEN
* COMPLETE STATE-VECTOR.
IF(ISTATE(1).EQ.0) THEN
ISTATE(1)=NMIL
ELSE IF(NMIL.NE.ISTATE(1)) THEN
WRITE(HSMG,'(42HCOMCAL: ELEMENTARY CALCULATION WITH AN INV,
1 22HALIB NB. OF MIXTURES =,I7,3H NE,I7,1H.)') NMIL,ISTATE(1)
CALL XABORT(HSMG)
ENDIF
ISTATE(2)=NG
ELSE
IF(NMIL.NE.ISTATE(1)) THEN
WRITE(HSMG,'(42HCOMCAL: ELEMENTARY CALCULATION WITH AN INV,
1 22HALIB NB. OF MIXTURES =,I7,3H NE,I7,1H.)') NMIL,ISTATE(1)
CALL XABORT(HSMG)
ELSE IF(NG.NE.ISTATE(2)) THEN
WRITE(HSMG,'(42HCOMCAL: ELEMENTARY CALCULATION WITH AN INV,
1 20HALIB NB. OF GROUPS =,I7,3H NE,I7,1H.)') NG,ISTATE(2)
CALL XABORT(HSMG)
ENDIF
ENDIF
ISTATE(3)=ISTATE(3)+1
IF(ISTATE(3).GT.ISTATE(4)) THEN
ISTATE(4)=ISTATE(4)+10
JPCPO=LCMLID(IPCPO,'MIXTURES',NMIL)
DO 10 IMIL=1,NMIL
KPCPO=LCMDIL(JPCPO,IMIL)
LPCPO=LCMLID(KPCPO,'CALCULATIONS',ISTATE(4))
10 CONTINUE
ENDIF
ICAL=ISTATE(3)
MAXCAL=ISTATE(4)
NISOP=ISTATE(13)
NGFF=ISTATE(14)
NALBP=ISTATE(15)
IDF=ISTATE(16)
*----
* RECOVER THE USER-REQUESTED PARTICULARIZED ISOTOPES
*----
IF(NISOP.GT.MAXISO) CALL XABORT('COMCAL: MAXISO OVERFLOW.')
IF(NISOP.GT.0) CALL LCMGTC(IPCPO,'NOMISP',8,NISOP,NOMISP)
*----
* RECOVER THE MACRO-GEOMETRY
*----
CALL LCMLEN(IPEDIT,'MACRO-GEOM',ILONG,ITYLCM)
IF(ILONG.NE.0) THEN
JPCPO=LCMLID(IPCPO,'GEOMETRIES',MAXCAL)
KPCPO=LCMDIL(JPCPO,ICAL)
CALL LCMSIX(IPEDIT,'MACRO-GEOM',1)
CALL LCMEQU(IPEDIT,KPCPO)
CALL LCMSIX(IPEDIT,' ',2)
ISTATE(11)=1
ENDIF
*----
* RECOVER THE FLUX NORMALIZATION FACTOR
*----
IF(C_ASSOCIATED(IPDEPL)) THEN
CALL LCMGET(IPDEPL,'BURNUP-IRRAD',BIRRAD)
BURN=BIRRAD(1)
CALL LCMLEN(IPDEPL,'FLUX-NORM',ILONG,ITYLCM)
IF(ILONG.EQ.0) THEN
CALL LCMLIB(IPDEPL)
WRITE(HSMG,'(40HCOMCAL: THE ''FLUX-NORM'' RECORD IS NOT SE,
1 20HT FOR BURNUP STEP AT,E12.5,14H MW-DAY/TONNE.)') BURN
CALL XABORT(HSMG)
ENDIF
CALL LCMGET(IPDEPL,'FLUX-NORM',FNORM)
IF(IMPX.GT.0) WRITE(6,100) FNORM,BURN
ELSE
FNORM=1.0
IF(IMPX.GT.0) WRITE(6,110)
ENDIF
*----
* RECOVER THE CROSS SECTIONS AND NORMALIZE THE FLUX
*----
CALL LCMSIX(IPEDIT,CDIRO,1)
CALL COMMIC(IMPX,IPCPO,IPEDIT,IPEDI2,LMACRO,ICAL,MAXCAL,NMIL,
1 NISOTS,NG,NED,NW,FNORM,LISO,NISOP,NOMISP,NGFF,NALBP,IDF,ITRES)
ISTATE(14)=NGFF
ISTATE(15)=NALBP
ISTATE(16)=IDF
CALL LCMSIX(IPEDIT,' ',2)
*----
* UPDATE THE STATE-VECTOR
*----
CALL LCMPUT(IPCPO,'STATE-VECTOR',NSTATE,1,ISTATE)
RETURN
*
100 FORMAT(45H COMCAL: NORMALIZE THE FLUX WITH THE FACTOR =,1P,E12.5,
1 26H TAKEN FROM BURNUP STEP AT,E12.5,14H MW-DAY/TONNE.)
110 FORMAT(36H COMCAL: THE FLUX IS NOT NORMALIZED.)
END
|
