]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/cgpack/cgfare.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Makefile added to PDF8
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgfare.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:19:43 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.31 by S.Giani
11*-- Author :
12 SUBROUTINE CGFARE(NT,FACE,IVIS,ISHAPE)
13************************************************************************
14* *
15* Name: CGFARE *
16* Author: S. Giani Date: 20.05.91 *
17* Revised: *
18* *
19* Function: HIDDEN FACE REMOVAL algoritm *
20* and transformation to screen coordinates *
21* *
22* References: none *
23* *
24* Input: NT - number of transformation to screen coordinates *
25* FACE - face *
26* *
27* Output: IVIS - visibility flag *
28* 1 - if visible face *
29* -1 - if unvisible *
30* *
31* *
32* *
33************************************************************************
34#include "geant321/cgcfac.inc"
35#include "geant321/cggpar.inc"
36#include "geant321/cgdelt.inc"
37#include "geant321/cgctra.inc"
38#include "geant321/gcspee.inc"
39#include "geant321/gcmutr.inc"
40***SG
41 DIMENSION ACCMI1(6),ACCMI2(6),ACCMI3(6),
42 + ACCMA1(6),ACCMA2(6),ACCMA3(6)
43 DIMENSION SMI(3),SMA(3),POMI(3),POMA(3)
44 SAVE ACCMI1,ACCMI2,ACCMI3,ACCMA1,ACCMA2,ACCMA3
45 SAVE POMI,POMA,ACCXT1,ACCXT2,ACCNT1,ACCNT2
46***SG
47 REAL FACE(*)
48#if !defined(CERNLIB_SINGLE)
49 DOUBLE PRECISION T(4,3),A,B,C,S
50#endif
51#if defined(CERNLIB_SINGLE)
52 REAL T(4,3)
53#endif
54*-
55 IVIS = -1
56 DO 120 I=1,4
57 DO 110 J=1,3
58 T(I,J) = TSCRN(I,J,NT)
59 110 CONTINUE
60 120 CONTINUE
61*
62***SG
63** HIDDEN FACE REMOVAL
64* Computing face scope and skipping if it's 'covered': this
65* can allow a great increase in speed and a great reduction
66* in number of memory words used.
67*
68 J = LCGFAC
69 NTIM=NTIM+1
70 SRFMI1 = FACE(J+KCGX1)
71 SRFMI2 = FACE(J+KCGY1)
72 SRFMI3 = FACE(J+KCGZ1)
73 SRFMA1 = FACE(J+KCGX1)
74 SRFMA2 = FACE(J+KCGY1)
75 SRFMA3 = FACE(J+KCGZ1)
76 NEDGE = FACE(KCGNE)
77 DO 333 NE=1,NEDGE
78 SRFMI1 = MIN(SRFMI1,FACE(J+KCGX1),FACE(J+KCGX2))
79 SRFMI2 = MIN(SRFMI2,FACE(J+KCGY1),FACE(J+KCGY2))
80 SRFMI3 = MIN(SRFMI3,FACE(J+KCGZ1),FACE(J+KCGZ2))
81 SRFMA1 = MAX(SRFMA1,FACE(J+KCGX1),FACE(J+KCGX2))
82 SRFMA2 = MAX(SRFMA2,FACE(J+KCGY1),FACE(J+KCGY2))
83 SRFMA3 = MAX(SRFMA3,FACE(J+KCGZ1),FACE(J+KCGZ2))
84 J = J + LCGEDG
85 333 CONTINUE
86* If volume set limits
87 IF(IPORLI.EQ.1)THEN
88* If no clipping or shifting or exploding mode
89 IF(NAIN.EQ.0.AND.KSHIFT.EQ.0.AND.GBOOM.EQ.0)THEN
90* If volume created by cgbox
91 IF(ISHAPE.LT.5.OR.ISHAPE.EQ.10)THEN
92* Set 'faces scope' for sublim faces created by cgbox
93 ACCMI1(NTIM) = SRFMI1
94 ACCMI2(NTIM) = SRFMI2
95 ACCMI3(NTIM) = SRFMI3
96 ACCMA1(NTIM) = SRFMA1
97 ACCMA2(NTIM) = SRFMA2
98 ACCMA3(NTIM) = SRFMA3
99* Set 'volume scope' for sublim faces of revolution
100 POMI(1)=S1
101 POMI(2)=S2
102 POMI(3)=S3
103 POMA(1)=SS1
104 POMA(2)=SS2
105 POMA(3)=SS3
106 ACCXT2=SRAGMX
107 ACCXT1=SRAGMN
108 ACCNT1=RAINT1
109 ACCNT2=RAINT2
110* If volume of revolution
111 ELSE
112* Set 'faces scope' for sublim faces created by cgbox
113 ACCMI1(4)=S1
114 ACCMI1(6)=SS1
115 ACCMI2(3)=SS2
116 ACCMI2(5)=S2
117 ACCMI3(1)=S3
118 ACCMI3(2)=SS3
119 ACCMA1(4)=S1
120 ACCMA1(6)=SS1
121 ACCMA2(3)=SS2
122 ACCMA2(5)=S2
123 ACCMA3(1)=S3
124 ACCMA3(2)=SS3
125* Set 'volume scope' and 'radial scope' for sublim faces of revolution
126 POMI(1)=S1
127 POMI(2)=S2
128 POMI(3)=S3
129 POMA(1)=SS1
130 POMA(2)=SS2
131 POMA(3)=SS3
132 ACCXT2=SRAGMX
133 ACCXT1=SRAGMN
134 ACCNT1=RAINT1
135 ACCNT2=RAINT2
136 ENDIF
137* If clipping or shifting or exploding mode on
138 ELSE
139* Set 'volume scope' for all sublim faces, and 'radial scope' as
140* well for sublim faces of revolution
141 POMI(1)=S1
142 POMI(2)=S2
143 POMI(3)=S3
144 POMA(1)=SS1
145 POMA(2)=SS2
146 POMA(3)=SS3
147 ACCXT2=SRAGMX
148 ACCXT1=SRAGMN
149 ACCNT1=RAINT1
150 ACCNT2=RAINT2
151 ENDIF
152* If volume is to be compared with limits
153 ELSEIF(ISUBLI.EQ.1)THEN
154* If no clipping or shifting or exploding mode
155 IF(NAIN.EQ.0.AND.KSHIFT.EQ.0.AND.GBOOM.EQ.0)THEN
156* If volume created by cgbox
157 IF(ISHAPE.LT.5.OR.ISHAPE.EQ.10)THEN
158* Comparison face by face
159 IF(NTIM.EQ.1)THEN
160 IF(SRFMI3.GT.ACCMI3(NTIM).AND.SRFMA3
161 + .GT.ACCMA3(NTIM))GOTO 999
162 ELSEIF(NTIM.EQ.2)THEN
163 IF(SRFMI3.LT.ACCMI3(NTIM).AND.SRFMA3
164 + .LT.ACCMA3(NTIM))GOTO 999
165 ELSEIF(NTIM.EQ.3)THEN
166 IF(SRFMI2.LT.ACCMI2(NTIM).AND.SRFMA2
167 + .LT.ACCMA2(NTIM))GOTO 999
168 ELSEIF(NTIM.EQ.5)THEN
169 IF(SRFMI2.GT.ACCMI2(NTIM).AND.SRFMA2
170 + .GT.ACCMA2(NTIM))GOTO 999
171 ELSEIF(NTIM.EQ.4)THEN
172 IF(SRFMI1.GT.ACCMI1(NTIM).AND.SRFMA1
173 + .GT.ACCMA1(NTIM))GOTO 999
174 ELSEIF(NTIM.EQ.6)THEN
175 IF(SRFMI1.LT.ACCMI1(NTIM).AND.SRFMA1
176 + .LT.ACCMA1(NTIM))GOTO 999
177 ENDIF
178 GOTO 888
179* If volume of revolution
180 ELSE
181* Comparison with mother scopes
182 SMI(1)=SRFMI1
183 SMI(2)=SRFMI2
184 SMI(3)=SRFMI3
185 SMA(1)=SRFMA1
186 SMA(2)=SRFMA2
187 SMA(3)=SRFMA3
188 EXTRA1=RMAX1
189 EXTRA2=RMAX2
190 ENTRA1=RMIN1
191 ENTRA2=RMIN2
192* If mother was created by cgbox or if it was of revolution
193 ISP=0
194 DO 127 I=1,3
195 SPMI=SMI(I)-POMI(I)
196 SPMA=SMA(I)-POMA(I)
197 ASPMI=ABS(SPMI)
198 ASPMA=ABS(SPMA)
199 SMIA=SMI(I)-SMA(I)
200 ASMIA=ABS(SMIA)
201 IF(SPMI.GE.-0.001.AND.SPMA.LE.0.001)THEN
202 ISP=ISP+1
203 IF(ASPMI.LE.0.001.OR.ASPMA.LE.0.001)THEN
204 IF(ASMIA.LE.0.001)GOTO 888
205 ENDIF
206 ENDIF
207 127 CONTINUE
208 IF(ISP.EQ.3)THEN
209* If mother was of revolution
210 IF(ACCXT2.NE.0)THEN
211 IF(ISCOP.EQ.1.AND.(ISHAPE.EQ.11.OR.ISHAPE.EQ.12
212 + .OR.ISHAPE.EQ.7.OR.ISHAPE.EQ.8))THEN
213 EXXT1=EXTRA1-ACCXT1
214 EXXT2=EXTRA2-ACCXT2
215 ENNT1=ENTRA1-ACCNT1
216 ENNT2=ENTRA2-ACCNT2
217 IF(EXXT1.LT.-0.001.AND.EXXT2.LT.-0.001.AND.
218 + ENNT1.GT.0.001.AND.ENNT2.GT.0.001)THEN
219 GOTO 999
220 ELSEIF(EXXT1.LT.-0.001.AND.EXXT2.LT.-0.001.AND.
221 + ACCNT1.LT.0.001.AND.ACCNT2.LT.0.001)THEN
222 GOTO 999
223 ELSE
224 GOTO 888
225 ENDIF
226 ELSE
227 DO 701 ITER=1,IPORNT
228 EXXT1=EXTRA1-PORMAR(ITER)
229 EXXT2=EXTRA2-PORMAR(ITER)
230 AEXXT1=ABS(EXXT1)
231 AEXXT2=ABS(EXXT2)
232 ENNT1=ENTRA1-PORMIR(ITER)
233 ENNT2=ENTRA2-PORMIR(ITER)
234 AENNT1=ABS(ENNT1)
235 AENNT2=ABS(ENNT2)
236 IF(AEXXT1.LT.0.001.OR.AEXXT2.LT.0.001)GOTO 888
237 IF(AENNT1.LT.0.001.OR.AENNT2.LT.0.001)THEN
238 IF(PORMIR(ITER).NE.0.)GOTO 888
239 ENDIF
240 701 CONTINUE
241 ENDIF
242 ENDIF
243 GOTO 999
244 ELSE
245 GOTO 888
246 ENDIF
247 ENDIF
248* If clipping or shifting or exploding mode on
249 ELSE
250* Get scopes of the daughter (of each kind)
251 SMI(1)=SRFMI1
252 SMI(2)=SRFMI2
253 SMI(3)=SRFMI3
254 SMA(1)=SRFMA1
255 SMA(2)=SRFMA2
256 SMA(3)=SRFMA3
257 EXTRA1=RMAX1
258 EXTRA2=RMAX2
259 ENTRA1=RMIN1
260 ENTRA2=RMIN2
261* If mother was clipped, check relative position of daughter and clipping
262* volumes; only if they don't interact, hidden face removal can work.
263 DO 111 IJ=1,JPORJJ
264 IFVFUN=0
265 DO 301 J=1,3
266 PMISMA=CLIPMI(J+3*IJ-3)-SMA(J)
267 SMIPMA=SMI(J)-CLIPMA(J+3*IJ-3)
268 APMISM=ABS(PMISMA)
269 ASMIPM=ABS(SMIPMA)
270 SMASMI=SMA(J)-SMI(J)
271 ASMASM=ABS(SMASMI)
272 IF(PMISMA.GE.-0.001.OR.
273 + SMIPMA.GE.-0.001)THEN
274 IFVFUN=1
275 IF(APMISM.LT.0.001.OR.
276 + ASMIPM.LT.0.001)THEN
277 IF(ASMASM.LT.0.0001)GOTO 888
278 ENDIF
279 GO TO 302
280 ENDIF
281 301 CONTINUE
282 302 CONTINUE
283 IF(IFVFUN.EQ.0.AND.NAIN.NE.3)GO TO 888
284 111 CONTINUE
285* If mother was created by cgbox or if it was of revolution
286 ISP=0
287 DO 128 I=1,3
288 SPMI=SMI(I)-POMI(I)
289 SPMA=SMA(I)-POMA(I)
290 ASPMI=ABS(SPMI)
291 ASPMA=ABS(SPMA)
292 SMIA=SMI(I)-SMA(I)
293 ASMIA=ABS(SMIA)
294 IF(SPMI.GE.-0.001.AND.SPMA.LE.0.001)THEN
295 ISP=ISP+1
296 IF(ASPMI.LE.0.001.OR.ASPMA.LE.0.001)THEN
297 IF(ASMIA.LE.0.001)GOTO 888
298 ENDIF
299 ENDIF
300 128 CONTINUE
301 IF(ISP.EQ.3)THEN
302* If mother was of revolution
303 IF(ACCXT2.NE.0)THEN
304 IF(ISCOP.EQ.1.AND.(ISHAPE.EQ.11.OR.ISHAPE.EQ.12
305 + .OR.ISHAPE.EQ.7.OR.ISHAPE.EQ.8))THEN
306 EXXT1=EXTRA1-ACCXT1
307 EXXT2=EXTRA2-ACCXT2
308 ENNT1=ENTRA1-ACCNT1
309 ENNT2=ENTRA2-ACCNT2
310 IF(EXXT1.LT.-0.001.AND.EXXT2.LT.-0.001.AND.
311 + ENNT1.GT.0.001.AND.ENNT2.GT.0.001)THEN
312 GOTO 999
313 ELSEIF(EXXT1.LT.-0.001.AND.EXXT2.LT.-0.001.AND.
314 + ACCNT1.LT.0.001.AND.ACCNT2.LT.0.001)THEN
315 GOTO 999
316 ELSE
317 GOTO 888
318 ENDIF
319 ELSE
320 DO 702 ITER=1,IPORNT
321 EXXT1=EXTRA1-PORMAR(ITER)
322 EXXT2=EXTRA2-PORMAR(ITER)
323 AEXXT1=ABS(EXXT1)
324 AEXXT2=ABS(EXXT2)
325 ENNT1=ENTRA1-PORMIR(ITER)
326 ENNT2=ENTRA2-PORMIR(ITER)
327 AENNT1=ABS(ENNT1)
328 AENNT2=ABS(ENNT2)
329 IF(AEXXT1.LT.0.001.OR.AEXXT2.LT.0.001)GOTO 888
330 IF(AENNT1.LT.0.001.OR.AENNT2.LT.0.001)THEN
331 IF(PORMIR(ITER).NE.0.)GOTO 888
332 ENDIF
333 702 CONTINUE
334 ENDIF
335 ENDIF
336 IF(ISCOP.EQ.1)THEN
337 IF((ISHAPE.GT.1.AND.ISHAPE.LT.5).OR.ISHAPE.EQ.10)
338 + GOTO 888
339 ENDIF
340 GOTO 999
341 ELSE
342 GOTO 888
343 ENDIF
344 ENDIF
345 ENDIF
346 888 CONTINUE
347*
348***SG
349*
350 C = (T(2,1)*T(3,2) - T(3,1)*T(2,2))*FACE(KCGAA) +
351 + (T(3,1)*T(1,2) - T(1,1)*T(3,2))*FACE(KCGBB) +
352 + (T(1,1)*T(2,2) - T(2,1)*T(1,2))*FACE(KCGCC)
353 IF (C .LE. 0.) GOTO 999
354 B = (T(2,3)*T(3,1) - T(3,3)*T(2,1))*FACE(KCGAA) +
355 + (T(3,3)*T(1,1) - T(1,3)*T(3,1))*FACE(KCGBB) +
356 + (T(1,3)*T(2,1) - T(2,3)*T(1,1))*FACE(KCGCC)
357 A = (T(2,2)*T(3,3) - T(3,2)*T(2,3))*FACE(KCGAA) +
358 + (T(3,2)*T(1,3) - T(1,2)*T(3,3))*FACE(KCGBB) +
359 + (T(1,2)*T(2,3) - T(2,2)*T(1,3))*FACE(KCGCC)
360 S = 1./SQRT(A*A+B*B+C*C)
361 AABCD(1) = A*S
362 AABCD(2) = B*S
363 AABCD(3) = C*S
364*
365 F1(KCGAF) = FACE(KCGAF)
366 F1(KCGNE) = FACE(KCGNE)
367 F1(KCGAA) = 0.
368 F1(KCGBB) = 0.
369 F1(KCGCC) = 1.
370 F1(KCGDD) = 0.
371 F1(KCGNE) = FACE(KCGNE)
372*
373** T R A S F E R P O I N T C O O R D I N A T E S
374*
375 NEDGE = FACE(KCGNE)
376 IF (LCGFAC+NEDGE*LCGEDG .GT. LABC)
377 + PRINT *, ' Problem in CGFVIS: no space'
378 XGRAV = 0.
379 YGRAV = 0.
380 ZGRAV = 0.
381 J = LCGFAC
382 DO 200 NE=1,NEDGE
383 F1(J+KCGAE) = FACE(J+KCGAE)
384 X = FACE(J+KCGX1)
385 Y = FACE(J+KCGY1)
386 Z = FACE(J+KCGZ1)
387 F1(J+KCGX1) = T(1,1)*X + T(2,1)*Y + T(3,1)*Z + T(4,1)
388 F1(J+KCGY1) = T(1,2)*X + T(2,2)*Y + T(3,2)*Z + T(4,2)
389 F1(J+KCGZ1) = T(1,3)*X + T(2,3)*Y + T(3,3)*Z + T(4,3)
390 X = FACE(J+KCGX2)
391 Y = FACE(J+KCGY2)
392 Z = FACE(J+KCGZ2)
393 F1(J+KCGX2) = T(1,1)*X + T(2,1)*Y + T(3,1)*Z + T(4,1)
394 F1(J+KCGY2) = T(1,2)*X + T(2,2)*Y + T(3,2)*Z + T(4,2)
395 F1(J+KCGZ2) = T(1,3)*X + T(2,3)*Y + T(3,3)*Z + T(4,3)
396 XGRAV = XGRAV + F1(J+KCGX1) + F1(J+KCGX2)
397 YGRAV = YGRAV + F1(J+KCGY1) + F1(J+KCGY2)
398 ZGRAV = ZGRAV + F1(J+KCGZ1) + F1(J+KCGZ2)
399 J = J + LCGEDG
400 200 CONTINUE
401 XFACT = 1./(2.*NEDGE)
402 XGRAV = XGRAV * XFACT
403 YGRAV = YGRAV * XFACT
404 ZGRAV = ZGRAV * XFACT
405 AABCD(4) =-(AABCD(1)*XGRAV + AABCD(2)*YGRAV + AABCD(3)*ZGRAV)
406*
407** F I N D F A C E M I N - M A X
408*
409 J = LCGFAC
410 RFMIN(1) = F1(J+KCGX1)
411 RFMIN(2) = F1(J+KCGY1)
412 RFMIN(3) = F1(J+KCGZ1)
413 RFMAX(1) = F1(J+KCGX1)
414 RFMAX(2) = F1(J+KCGY1)
415 RFMAX(3) = F1(J+KCGZ1)
416 DO 300 NE=1,NEDGE
417 RFMIN(1) = MIN(RFMIN(1),F1(J+KCGX1),F1(J+KCGX2))
418 RFMIN(2) = MIN(RFMIN(2),F1(J+KCGY1),F1(J+KCGY2))
419 RFMIN(3) = MIN(RFMIN(3),F1(J+KCGZ1),F1(J+KCGZ2))
420 RFMAX(1) = MAX(RFMAX(1),F1(J+KCGX1),F1(J+KCGX2))
421 RFMAX(2) = MAX(RFMAX(2),F1(J+KCGY1),F1(J+KCGY2))
422 RFMAX(3) = MAX(RFMAX(3),F1(J+KCGZ1),F1(J+KCGZ2))
423 F1(J+KCGZ1) = 0.
424 F1(J+KCGZ2) = 0.
425 J = J + LCGEDG
426 300 CONTINUE
427 DRFACE(1) =-RFMAX(1)
428 DRFACE(2) =-RFMAX(2)
429 DRFACE(3) = RFMIN(1)
430 DRFACE(4) = RFMIN(2)
431 DRFACE(5) = RFMIN(3)
432*
433** C O M P U T E F A C E V I S I B L E A R E A
434*
435 J = LCGFAC
436 S = 0.
437 DLMAX = 0.
438 DO 400 NE=1,NEDGE
439 S = S + F1(J+KCGX1)*F1(J+KCGY2) - F1(J+KCGX2)*F1(J+KCGY1)
440 DL = ABS(F1(J+KCGX2)-F1(J+KCGX1)) + ABS(F1(J+KCGY2)-F1(J+
441 + KCGY1))
442 IF (DLMAX .LT. DL) DLMAX = DL
443 J = J + LCGEDG
444 400 CONTINUE
445 IF (DLMAX .LT. EESCR) GOTO 999
446 IF (S .GT. DLMAX*EESCR) IVIS = 1
447*
448 999 RETURN
449 END