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 TINMIC
SUBROUTINE TINMIC(IPMIC,IPMIC2,IPMIC3,NB,NCH,NW,ICH,NISO,NISO2,
1 IWORK,BSH,NDENS)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Microscopic refueling to update the microlib (micro-depletion)
*
*Copyright:
* Copyright (C) 2010 Ecole Polytechnique de Montreal
*
*Author(s):
* M. Guyot
*
*Parameters: input/output
* IPMIC Adress of the L_LIBRARY in creation mode.
* IPMIC2 Adress of the fuel-map L_LIBRARY in read-only mode.
* IPMIC3 Adress of the L_LIBRARY in read-only mode, containing new
* fuel properties.
* NB Number of bundles
* NCH Number of channels
* NW Vector containing new index for the refuelling
* ICH Number of the channel to refuel
* NISO Number of isotopes in the fuel-map microlib
* NISO2 Number of isotopes in the third microlib
* IWORK Useful vector for refueling
* BSH Vector containing new mixtures after shifting
* NDENS New isotopic densities after refueling
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMIC,IPMIC2,IPMIC3
INTEGER NB,NCH,NW(NB),ICH,NISO,NISO2,IWORK(NB,2),BSH(NB)
REAL NDENS(NISO)
*----
* LOCAL VARIABLES
*----
PARAMETER (IOUT=6,MAXISO=100)
INTEGER IB,ISO,ISO2,IMIX,I,SHT(NB),IND(MAXISO),IND2(MAXISO),I1,I2
CHARACTER TEXT*12,TEXT2*12
LOGICAL LMIX
TYPE(C_PTR) JPMIC2,JPMIC3
INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,MIX2,TODO,TODO2,TYP,TYP2
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAME,NAME2,USED,USED2
REAL, ALLOCATABLE, DIMENSION(:) :: DENS,DENS2,TEMP,TEMP2,VOL,VOL2
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(MIX(NISO),MIX2(NISO2),TODO(NISO),TODO2(NISO2),TYP(NISO),
1 TYP2(NISO2))
ALLOCATE(NAME(3,NISO),NAME2(3,NISO2),USED(3,NISO),USED2(3,NISO2))
ALLOCATE(DENS(NISO),DENS2(NISO2),TEMP(NISO),TEMP2(NISO2),
1 VOL(NISO),VOL2(NISO2))
*----
* RECOVER INFORMATION
*----
CALL LCMGET(IPMIC2,'ISOTOPESMIX',MIX)
CALL LCMGET(IPMIC3,'ISOTOPESMIX',MIX2)
CALL LCMGET(IPMIC2,'ISOTOPERNAME',NAME)
CALL LCMGET(IPMIC3,'ISOTOPERNAME',NAME2)
CALL LCMGET(IPMIC2,'ISOTOPESUSED',USED)
CALL LCMGET(IPMIC3,'ISOTOPESUSED',USED2)
CALL LCMGET(IPMIC2,'ISOTOPESDENS',DENS)
CALL LCMGET(IPMIC3,'ISOTOPESDENS',DENS2)
CALL LCMGET(IPMIC2,'ISOTOPESTODO',TODO)
CALL LCMGET(IPMIC3,'ISOTOPESTODO',TODO2)
CALL LCMGET(IPMIC2,'ISOTOPESTYPE',TYP)
CALL LCMGET(IPMIC3,'ISOTOPESTYPE',TYP2)
CALL LCMGET(IPMIC2,'ISOTOPESTEMP',TEMP)
CALL LCMGET(IPMIC3,'ISOTOPESTEMP',TEMP2)
CALL LCMGET(IPMIC2,'ISOTOPESVOL',VOL)
CALL LCMGET(IPMIC3,'ISOTOPESVOL',VOL2)
*----
* CHECK IF THE MIXTURES TO SHIFT EXIST IN THE MICROLIB
*----
DO 10 IB=1,NB
LMIX=.FALSE.
DO 15 ISO2=1,NISO2
IF(MIX2(ISO2).EQ.IWORK(IB,2)) THEN
LMIX=.TRUE.
ENDIF
15 CONTINUE
IMIX=MIX2(ISO2)
IF(.NOT.LMIX) THEN
WRITE(IOUT,*) '@TINMIC: THE MIXTURE ',IMIX,' IS NOT PRESENT '
+ //'IN THE MICROLIB FOR THE REFUEL. '
CALL XABORT('@TINMIC: REFUELING ERROR. ')
ENDIF
10 CONTINUE
*----
* COMPUTE THE VECTORS FOR THE REFUELING
*----
* SHT CONTAINS THE MIXTURES OF THE CHANNEL TO SHIFT
SHT(:NB)=0
DO I=1,NB
SHT(I)=ICH+(I-1)*NCH
ENDDO
* BSH CONTAINS THE NEW MIXTURE AFTER SHIFTING
DO I=1,NB
IF(NW(I).EQ.0) THEN
BSH(I)=0
ELSE
BSH(I)=SHT(NW(I))
ENDIF
ENDDO
CALL LCMGET(IPMIC,'ISOTOPESDENS',NDENS)
DO 20 IB=1,NB
IND(:MAXISO)=0
IND2(:MAXISO)=0
I1=0
I2=0
DO 25 ISO=1,NISO
IF(MIX(ISO).EQ.SHT(IB)) THEN
I1=I1+1
IF(I1.GE.MAXISO) CALL XABORT('@TINMIC: NUMBER OF ISOTOPES'
+ //' OVERFLOW(1). ')
IND(I1)=ISO
ENDIF
25 CONTINUE
IF(BSH(IB).EQ.0) THEN
* THE PROPERTIES ARE RECOVERED FROM THE THIRD LIBRARY
DO 30 ISO2=1,NISO2
IF(MIX2(ISO2).EQ.IWORK(IB,2)) THEN
I2=I2+1
IF(I2.GE.MAXISO) CALL XABORT('@TINMIC: NUMBER OF ISOTOPES'
+ //' OVERFLOW(2). ')
IND2(I2)=ISO2
ENDIF
30 CONTINUE
IF(I1.NE.I2) CALL XABORT('@TINMIC: WRONG NUMBER OF ISOTOPES '
+ //'IN THE NEW MIXTURE(1). ')
DO 35 J=1,I1
NDENS(IND(J))=DENS2(IND2(J))
WRITE(TEXT,'(3A4)') (USED(I0,IND(J)),I0=1,3)
WRITE(TEXT2,'(3A4)') (USED2(I0,IND2(J)),I0=1,3)
JPMIC3=LCMGID(IPMIC3,TEXT2)
CALL LCMSIX(IPMIC,TEXT,1)
CALL LCMEQU(JPMIC3,IPMIC)
CALL LCMSIX(IPMIC,' ',2)
35 CONTINUE
* THE PROPERTIES ARE RECOVERED FROM THE FUEL MAP LIBRARY
ELSE
DO 40 ISO=1,NISO
IF(MIX(ISO).EQ.BSH(IB)) THEN
I2=I2+1
IF(I2.GE.MAXISO) CALL XABORT('@TINMIC: NUMBER OF ISOTOPES'
+ //' OVERFLOW(3). ')
IND2(I2)=ISO
ENDIF
40 CONTINUE
IF(I1.NE.I2) CALL XABORT('@TINMIC: WRONG NUMBER OF ISOTOPES '
+ //'IN THE NEW MIXTURE(2). ')
DO 45 J=1,I1
NDENS(IND(J))=DENS(IND2(J))
WRITE(TEXT,'(3A4)') (USED(I0,IND(J)),I0=1,3)
WRITE(TEXT2,'(3A4)') (USED(I0,IND2(J)),I0=1,3)
JPMIC2=LCMGID(IPMIC2,TEXT2)
CALL LCMSIX(IPMIC,TEXT,1)
CALL LCMEQU(JPMIC2,IPMIC)
CALL LCMSIX(IPMIC,' ',2)
45 CONTINUE
ENDIF
20 CONTINUE
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(VOL2,VOL,TEMP2,TEMP,DENS2,DENS)
DEALLOCATE(USED2,USED,NAME2,NAME)
DEALLOCATE(TYP2,TYP,TODO2,TODO,MIX2,MIX)
RETURN
END
|
