This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgfvis.F
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 CGFVIS(NT,FACE,IVIS,ISHAPE)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGFVIS                                                     *
16 *     Authors: E. Chernyaev, S. Giani            Date:    01.08.89     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Transfer face to screen coordinates                    *
20 *               and find face min-max and face visibility              *
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 *     Errors: none                                                     *
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 ***SG
40       DIMENSION ACCMI1(6),ACCMI2(6),ACCMI3(6),
41      +          ACCMA1(6),ACCMA2(6),ACCMA3(6)
42 ***SG
43       REAL      FACE(*)
44 #if !defined(CERNLIB_SINGLE)
45       DOUBLE PRECISION  T(4,3),A,B,C,S
46 #endif
47 #if defined(CERNLIB_SINGLE)
48       REAL      T(4,3)
49 #endif
50 *-
51       IVIS   = -1
52       DO 120 I=1,4
53          DO 110 J=1,3
54             T(I,J) = TSCRN(I,J,NT)
55   110    CONTINUE
56   120 CONTINUE
57 *
58 ***SG
59 **         HIDDEN FACE REMOVAL
60 *     Computing face scope and skipping if it's 'covered': this
61 *     can allow a great increase in speed and a great reduction
62 *     in number of memory words used.
63 *
64       IF(ISHAPE.LE.4.OR.ISHAPE.EQ.10)THEN
65          NTIM=NTIM+1
66          J = LCGFAC
67          SRFMI1 = FACE(J+KCGX1)
68          SRFMI2 = FACE(J+KCGY1)
69          SRFMI3 = FACE(J+KCGZ1)
70          SRFMA1 = FACE(J+KCGX1)
71          SRFMA2 = FACE(J+KCGY1)
72          SRFMA3 = FACE(J+KCGZ1)
73          NEDGE = FACE(KCGNE)
74          DO 333 NE=1,NEDGE
75             SRFMI1 = MIN(SRFMI1,FACE(J+KCGX1),FACE(J+KCGX2))
76             SRFMI2 = MIN(SRFMI2,FACE(J+KCGY1),FACE(J+KCGY2))
77             SRFMI3 = MIN(SRFMI3,FACE(J+KCGZ1),FACE(J+KCGZ2))
78             SRFMA1 = MAX(SRFMA1,FACE(J+KCGX1),FACE(J+KCGX2))
79             SRFMA2 = MAX(SRFMA2,FACE(J+KCGY1),FACE(J+KCGY2))
80             SRFMA3 = MAX(SRFMA3,FACE(J+KCGZ1),FACE(J+KCGZ2))
81             J = J + LCGEDG
82   333    CONTINUE
83          IF(IPORLI.EQ.1)THEN
84             ACCMI1(NTIM) = SRFMI1
85             ACCMI2(NTIM) = SRFMI2
86             ACCMI3(NTIM) = SRFMI3
87             ACCMA1(NTIM) = SRFMA1
88             ACCMA2(NTIM) = SRFMA2
89             ACCMA3(NTIM) = SRFMA3
90          ELSEIF(ISUBLI.EQ.1)THEN
91             IF(NTIM.EQ.1.OR.NTIM.EQ.2)THEN
92                IF(SRFMI3.LT.ACCMI3(NTIM).AND.SRFMA3
93      +         .LT.ACCMA3(NTIM))GOTO 999
94             ELSEIF(NTIM.EQ.3.OR.NTIM.EQ.5)THEN
95                IF(SRFMI2.LT.ACCMI2(NTIM).AND.SRFMA2
96      +         .LT.ACCMA2(NTIM))GOTO 999
97             ELSEIF(NTIM.EQ.4.OR.NTIM.EQ.6)THEN
98                IF(SRFMI1.LT.ACCMI1(NTIM).AND.SRFMA1
99      +         .LT.ACCMA1(NTIM))GOTO 999
100             ENDIF
101          ENDIF
102       ENDIF
103 *
104 ***SG
105 *
106       C      = (T(2,1)*T(3,2) - T(3,1)*T(2,2))*FACE(KCGAA) +
107      +         (T(3,1)*T(1,2) - T(1,1)*T(3,2))*FACE(KCGBB) +
108      +         (T(1,1)*T(2,2) - T(2,1)*T(1,2))*FACE(KCGCC)
109       IF (C .LE. 0.)     GOTO 999
110       B      = (T(2,3)*T(3,1) - T(3,3)*T(2,1))*FACE(KCGAA) +
111      +         (T(3,3)*T(1,1) - T(1,3)*T(3,1))*FACE(KCGBB) +
112      +         (T(1,3)*T(2,1) - T(2,3)*T(1,1))*FACE(KCGCC)
113       A      = (T(2,2)*T(3,3) - T(3,2)*T(2,3))*FACE(KCGAA) +
114      +         (T(3,2)*T(1,3) - T(1,2)*T(3,3))*FACE(KCGBB) +
115      +         (T(1,2)*T(2,3) - T(2,2)*T(1,3))*FACE(KCGCC)
116       S      = 1./SQRT(A*A+B*B+C*C)
117       AABCD(1) = A*S
118       AABCD(2) = B*S
119       AABCD(3) = C*S
120 *
121       F1(KCGAF) = FACE(KCGAF)
122       F1(KCGNE) = FACE(KCGNE)
123       F1(KCGAA) = 0.
124       F1(KCGBB) = 0.
125       F1(KCGCC) = 1.
126       F1(KCGDD) = 0.
127       F1(KCGNE) = FACE(KCGNE)
128 *
129 **           T R A S F E R   P O I N T   C O O R D I N A T E S
130 *
131       NEDGE  = FACE(KCGNE)
132       IF (LCGFAC+NEDGE*LCGEDG .GT. LABC)
133      +       PRINT *, ' Problem in CGFVIS: no space'
134       XGRAV  = 0.
135       YGRAV  = 0.
136       ZGRAV  = 0.
137       J      = LCGFAC
138       DO 200 NE=1,NEDGE
139          F1(J+KCGAE) = FACE(J+KCGAE)
140          X = FACE(J+KCGX1)
141          Y = FACE(J+KCGY1)
142          Z = FACE(J+KCGZ1)
143          F1(J+KCGX1) = T(1,1)*X + T(2,1)*Y + T(3,1)*Z + T(4,1)
144          F1(J+KCGY1) = T(1,2)*X + T(2,2)*Y + T(3,2)*Z + T(4,2)
145          F1(J+KCGZ1) = T(1,3)*X + T(2,3)*Y + T(3,3)*Z + T(4,3)
146          X = FACE(J+KCGX2)
147          Y = FACE(J+KCGY2)
148          Z = FACE(J+KCGZ2)
149          F1(J+KCGX2) = T(1,1)*X + T(2,1)*Y + T(3,1)*Z + T(4,1)
150          F1(J+KCGY2) = T(1,2)*X + T(2,2)*Y + T(3,2)*Z + T(4,2)
151          F1(J+KCGZ2) = T(1,3)*X + T(2,3)*Y + T(3,3)*Z + T(4,3)
152          XGRAV = XGRAV + F1(J+KCGX1) + F1(J+KCGX2)
153          YGRAV = YGRAV + F1(J+KCGY1) + F1(J+KCGY2)
154          ZGRAV = ZGRAV + F1(J+KCGZ1) + F1(J+KCGZ2)
155          J = J + LCGEDG
156   200 CONTINUE
157       XFACT = 1./(2.*NEDGE)
158       XGRAV = XGRAV * XFACT
159       YGRAV = YGRAV * XFACT
160       ZGRAV = ZGRAV * XFACT
161       AABCD(4) =-(AABCD(1)*XGRAV + AABCD(2)*YGRAV + AABCD(3)*ZGRAV)
162 *
163 **           F I N D   F A C E   M I N - M A X
164 *
165       J      = LCGFAC
166       RFMIN(1) = F1(J+KCGX1)
167       RFMIN(2) = F1(J+KCGY1)
168       RFMIN(3) = F1(J+KCGZ1)
169       RFMAX(1) = F1(J+KCGX1)
170       RFMAX(2) = F1(J+KCGY1)
171       RFMAX(3) = F1(J+KCGZ1)
172       DO 300 NE=1,NEDGE
173          RFMIN(1) = MIN(RFMIN(1),F1(J+KCGX1),F1(J+KCGX2))
174          RFMIN(2) = MIN(RFMIN(2),F1(J+KCGY1),F1(J+KCGY2))
175          RFMIN(3) = MIN(RFMIN(3),F1(J+KCGZ1),F1(J+KCGZ2))
176          RFMAX(1) = MAX(RFMAX(1),F1(J+KCGX1),F1(J+KCGX2))
177          RFMAX(2) = MAX(RFMAX(2),F1(J+KCGY1),F1(J+KCGY2))
178          RFMAX(3) = MAX(RFMAX(3),F1(J+KCGZ1),F1(J+KCGZ2))
179          F1(J+KCGZ1) = 0.
180          F1(J+KCGZ2) = 0.
181          J = J + LCGEDG
182   300 CONTINUE
183       DRFACE(1) =-RFMAX(1)
184       DRFACE(2) =-RFMAX(2)
185       DRFACE(3) = RFMIN(1)
186       DRFACE(4) = RFMIN(2)
187       DRFACE(5) = RFMIN(3)
188 *
189 **          C O M P U T E    F A C E    V I S I B L E    A R E A
190 *
191       J      = LCGFAC
192       S      = 0.
193       DLMAX  = 0.
194       DO 400 NE=1,NEDGE
195          S = S + F1(J+KCGX1)*F1(J+KCGY2) - F1(J+KCGX2)*F1(J+KCGY1)
196          DL = ABS(F1(J+KCGX2)-F1(J+KCGX1)) + ABS(F1(J+KCGY2)-F1(J+
197      +   KCGY1))
198          IF (DLMAX .LT. DL) DLMAX = DL
199          J = J + LCGEDG
200   400 CONTINUE
201       IF (DLMAX .LT. EESCR)     GOTO 999
202       IF (S .GT. DLMAX*EESCR)   IVIS = 1
203 *
204   999 RETURN
205       END