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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
*DECK SYB4TS
SUBROUTINE SYB4TS(NA,NRD,NSECT,LSECT,NREG,COTEA,COTEB,RAYRE,
1 ILIGN,IQW,DELR,LFAIRE,VOL,NZR,ZZR,NZI,ZZI)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Compute the tracking information related to a square or rectangular
* sectorized heterogeneous cell.
*
*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
* NA number of angles in (0,$\\pi$/2).
* NRD one plus the number of tubes in the cell.
* NSECT number of sectors.
* LSECT type of sectorization:
* =-999 no sectorization / processed as a sectorized cell;
* =-101 X-type sectorization of the coolant;
* =-1 X-type sectorization of the cell;
* =101 +-type sectorization of the coolant;
* =1 +-type sectorization of the cell;
* =102 + and X-type sectorization of the coolant;
* =2 + and X-type sectorization of the cell.
* NREG number of regions in the cell.
* COTEA X-axis Cartesian dimension of the cell.
* COTEB Y-axis Cartesian dimension of the cell.
* RAYRE radius of each cylinder.
* ILIGN tracking print flag (=1 to print the tracking).
* IQW equal weight quadrature flag (=1 to use equal weight
* quadratures in angle and space).
* DELR half distance between the tracks.
* LFAIRE tracking calculation flag (=.FALSE. only compute the number
* of tracks).
*
*Parameters: output
* VOL volumes.
* NZR number of real elements in vector ZZR.
* ZZR real tracking information.
* NZI number of integer elements in vector ZZI.
* ZZI integer tracking information.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NA,NRD,NSECT,LSECT,NREG,ILIGN,IQW,NZR,NZI,ZZI(*)
REAL COTEA,COTEB,RAYRE(NRD-1),DELR,VOL(NREG),ZZR(*)
LOGICAL LFAIRE
*----
* LOCAL VARIABLES
*----
PARAMETER (DXMIN=1.E-3,PIO2=1.570796327)
REAL ZA(64),WA(64)
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NUMREG
REAL, ALLOCATABLE, DIMENSION(:) :: XCOTEA,XCOTEB
REAL, ALLOCATABLE, DIMENSION(:,:) :: VOLINT
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(NUMREG(NSECT,NRD))
ALLOCATE(VOLINT(NSECT,NRD),XCOTEA(NRD),XCOTEB(NRD))
*
IF(NA.GT.64) CALL XABORT('SYB4TS: NA IS GREATER THAN 64.')
IF(2.0*RAYRE(NRD-1).GT.SQRT(COTEA**2+COTEB**2)) THEN
CALL XABORT('SYB4TS: A RADIUS IS GREATER THAN HALF THE DIAGO'
1 //'NAL OF THE RECTANGLE.')
ENDIF
IF(IQW.EQ.0) THEN
* GAUSS-LEGENDRE INTEGRATION POINTS.
CALL ALGPT(NA,-1.0,1.0,ZA,WA)
ELSE
* EQUAL WEIGHT INTEGRATION POINTS.
DO 10 I=1,NA
ZA(I)=(2.0*REAL(I)-1.0)/REAL(NA)-1.0
WA(I)=2.0/REAL(NA)
10 CONTINUE
ENDIF
*----
* SET ZZI(1:2) AND COMPUTE THE NUMERICAL ORTHONORMALIZATION FACTORS
*----
IF(LFAIRE) THEN
ZZI(1)=3
ZZI(2)=1
ZN1=0.0
ZN2=0.0
ZN3=0.0
DO 20 IA=1,NA
PHI=0.5*PIO2*(ZA(IA)+1.0)
SI=SIN(PHI)
ZN1=ZN1+SI*WA(IA)
ZN2=ZN2+SI*SI*WA(IA)
ZN3=ZN3+SI*SI*SI*WA(IA)
20 CONTINUE
ZN1=0.5*ZN1*PIO2
ZN2=0.5*ZN2*PIO2
ZN3=0.5*ZN3*PIO2
ZZR(1)=1.0/SQRT(ZN1)
ZZR(2)=1.0/SQRT(0.75*ZN3-0.7205061948*ZN2*ZN2/ZN1)
ZZR(3)=ZZR(2)*0.8488263632*ZN2/ZN1
ZZR(4)=2.0/SQRT(3.0*(ZN1-ZN3))
IF(ILIGN.GT.0) WRITE (6,210) (ZZR(I),I=1,4)
ENDIF
*----
* COMPUTE THE VOLUMES AND NUMREG
*----
CALL SYB4VO(NSECT,NRD,COTEA,COTEB,RAYRE,VOLINT)
IND=0
DO 50 I=1,NRD-1
IF(ABS(LSECT).GT.100) THEN
IND=IND+1
DO 30 ISEC=1,NSECT
NUMREG(ISEC,I)=IND
30 CONTINUE
ELSE IF(LSECT.EQ.-1) THEN
NUMREG(1,I)=IND+4
NUMREG(2,I)=IND+1
NUMREG(3,I)=IND+1
NUMREG(4,I)=IND+2
NUMREG(5,I)=IND+2
NUMREG(6,I)=IND+3
NUMREG(7,I)=IND+3
NUMREG(8,I)=IND+4
IND=IND+4
ELSE
DO 40 ISEC=1,NSECT
IND=IND+1
NUMREG(ISEC,I)=IND
40 CONTINUE
ENDIF
50 CONTINUE
IF(LSECT.EQ.-999) THEN
IND=IND+1
DO 60 ISEC=1,NSECT
NUMREG(ISEC,I)=IND
60 CONTINUE
ELSE IF((LSECT.EQ.-1).OR.(LSECT.EQ.-101)) THEN
NUMREG(1,I)=IND+4
NUMREG(2,I)=IND+1
NUMREG(3,I)=IND+1
NUMREG(4,I)=IND+2
NUMREG(5,I)=IND+2
NUMREG(6,I)=IND+3
NUMREG(7,I)=IND+3
NUMREG(8,I)=IND+4
IND=IND+4
ELSE
DO 70 ISEC=1,NSECT
IND=IND+1
NUMREG(ISEC,I)=IND
70 CONTINUE
ENDIF
DO 80 I=1,NREG
VOL(I)=0.0
80 CONTINUE
DO 95 IR=1,NRD
DO 90 IS=1,NSECT
IND=NUMREG(IS,IR)
VOL(IND)=VOL(IND)+VOLINT(IS,IR)
90 CONTINUE
95 CONTINUE
*----
* INTERSECTION OF COTEB WITH THE TUBES
*----
H2=0.25*COTEB*COTEB
DO 100 MRE=NRD-1,1,-1
XI=RAYRE(MRE)*RAYRE(MRE)-H2
IF(XI.GT.0.0) THEN
XCOTEA(MRE)=SQRT(XI)
ELSE
JMINRA=MRE+1
GO TO 110
ENDIF
100 CONTINUE
JMINRA=1
*----
* INTERSECTION OF COTEA WITH THE TUBES
*----
110 H2=0.25*COTEA*COTEA
DO 120 MRE=NRD-1,1,-1
XI=RAYRE(MRE)*RAYRE(MRE)-H2
IF(XI.GT.0.0) THEN
XCOTEB(MRE)=SQRT(XI)
ELSE
JMINRB=MRE+1
GO TO 130
ENDIF
120 CONTINUE
JMINRB=1
*
130 IZI=3
IZR=5
MZIS=1
MZRS=1
NXMIN=999999999
NXMAX=0
DO 140 IFAC=0,3
MZIR=MZIS
MZRR=MZRS
CALL SYB4TR(NA,NRD,NSECT,COTEA,COTEB,RAYRE,IFAC,NUMREG,JMINRA,
1 XCOTEA(JMINRA),JMINRB,XCOTEB(JMINRB),LFAIRE,DXMIN,DELR,IQW,
2 WA,ZA,NXMIN,NXMAX,MZRR,ZZR(IZR),MZIR,ZZI(IZI))
IZI=IZI+MZIR
IZR=IZR+MZRR
140 CONTINUE
NZI=IZI
NZR=IZR
*
IF((ILIGN.GT.0).AND.(.NOT.LFAIRE)) THEN
WRITE(6,200) NA,NRD,NSECT,COTEA,COTEB,DXMIN,DELR,NZI,NZR,
1 NXMIN,NXMAX
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(XCOTEB,XCOTEA,VOLINT)
DEALLOCATE(NUMREG)
RETURN
*
200 FORMAT(/49H SYB4TS: TRACKING OF A SECTORIZED CARTESIAN CELL./
1 7H NA ,I8,29H (NUMBER OF ANGLES IN PI/2)/
2 7H NRD ,I8,22H (1+NUMBER OF TUBES)/
3 7H NSECT ,I8,22H (NUMBER OF SECTORS)/
4 7H COTEA ,1P,E8.1,16H (X-AXIS SIDE)/
5 7H COTEB ,1P,E8.1,16H (Y-AXIS SIDE)/
6 7H DXMIN ,1P,E8.1,24H (GEOMETRICAL EPSILON)/
7 7H DELR ,1P,E8.1,37H (HALF DISTANCE BETWEEN THE TRACKS)/
8 7H NZI ,I8,40H (NUMBER OF INTEGER TRACKING ELEMENTS)/
9 7H NZR ,I8,37H (NUMBER OF REAL TRACKING ELEMENTS)/
1 7H NXMIN ,I8,37H (MINIMUM NB. OF TRACKS PER REGION)/
2 7H NXMAX ,I8,37H (MAXIMUM NB. OF TRACKS PER REGION))
210 FORMAT (/47H SYB4TS: NUMERICAL ORTHONORMALIZATION FACTORS =,1P,
1 4E12.4/)
END
|
