This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgzre.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:45  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.32  by  S.Giani
11 *-- Author :
12       SUBROUTINE CGZRE(K,CG,LCG)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGZROT                                                     *
16 *     Author: E. Chernyaev                       Date:    01.02.89     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Rotate edge about Z-axis                               *
20 *                                                                      *
21 *     References: none                                                 *
22 *                                                                      *
23 *     Input: K  - number for step                                      *
24 *            CG - CG-object                                            *
25 *                                                                      *
26 *     Output: LCG - last index in CG-object                            *
27 *                                                                      *
28 *     Errors: none                                                     *
29 *                                                                      *
30 ************************************************************************
31 #include "geant321/cggpar.inc"
32 #include "geant321/cgdelt.inc"
33 #include "geant321/cgcaan.inc"
34 #if !defined(CERNLIB_SINGLE)
35       DOUBLE PRECISION  X1,Y1,H1,X2,Y2,H2,AW,AA,BB,CC,DD,S
36       DOUBLE PRECISION  D1,D2,DX1,DY1,DH1,DX2,DY2,DH2
37 #endif
38       REAL      CG(*)
39 *-
40       J      = 0
41       D1     = ABS(XYHA(1,1)) + ABS(XYHA(2,1))
42       D2     = ABS(XYHA(1,2)) + ABS(XYHA(2,2))
43       IF (D1.LT.EEWOR .AND. D2.LT.EEWOR)        GOTO 999
44       X1     = XYHA(1,1)*COSI - XYHA(2,1)*SINI
45       Y1     = XYHA(1,1)*SINI + XYHA(2,1)*COSI
46       X2     = XYHA(1,2)*COSI - XYHA(2,2)*SINI
47       Y2     = XYHA(1,2)*SINI + XYHA(2,2)*COSI
48       H1     = XYHA(3,1)
49       H2     = XYHA(3,2)
50       IF (ABS(H1-H2) .LT. EEWOR)               GOTO 200
51       DX1    = X1 - (X2*COSDA(K)-Y2*SINDA(K))
52       DY1    = Y1 - (X2*SINDA(K)+Y2*COSDA(K))
53       DH1    = H1 - H2
54       DX2    = (X1*COSDA(K)-Y1*SINDA(K)) - X2
55       DY2    = (X1*SINDA(K)+Y1*COSDA(K)) - Y2
56       DH2    = H1 - H2
57       AA     = DY1*DH2 - DY2*DH1
58       BB     = DH1*DX2 - DH2*DX1
59       CC     = DX1*DY2 - DX2*DY1
60       S      = SQRT(AA*AA + BB*BB + CC*CC)
61       IF (S .LT. EEWOR)                         GOTO 999
62       AA     = AA / S
63       BB     = BB / S
64       CC     = CC / S
65       DD     =-(AA*X1 + BB*Y1 + CC*H1)
66       DO 130 I=1,NASTP(K)
67         CG(J+KCGAF) = 0.
68         CG(J+KCGAA) = AA
69         CG(J+KCGBB) = BB
70         CG(J+KCGCC) = CC
71         CG(J+KCGDD) = DD
72         AW     = AA*COSDA(K) - BB*SINDA(K)
73         BB     = AA*SINDA(K) + BB*COSDA(K)
74         AA     = AW
75         CG(J+KCGNE) = 4.
76         IF (D1.LT.EEWOR .OR. D2.LT.EEWOR)       CG(J+KCGNE) = 3.
77         J      = J + LCGFAC
78 *
79         CG(J+KCGAE) = ATREDG
80         IF (I.EQ.1 .AND. IFULL.EQ.0)    CG(J+KCGAE) = 0.
81         CG(J+KCGX1) = X2
82         CG(J+KCGY1) = Y2
83         CG(J+KCGZ1) = H2
84         CG(J+KCGX2) = X1
85         CG(J+KCGY2) = Y1
86         CG(J+KCGZ2) = H1
87         J      = J + LCGEDG
88 *
89         IF (D1 .LT. EEWOR)              GOTO 110
90         CG(J+KCGAE) = XYHA(4,1)
91         CG(J+KCGX1) = X1
92         CG(J+KCGY1) = Y1
93         CG(J+KCGZ1) = H1
94         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
95      +                         CG(J+KCGX2) = X1*COSDA(K) - Y1*SINDA(K)
96         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
97      +                         CG(J+KCGY2) = X1*SINDA(K) + Y1*COSDA(K)
98         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
99      +                         CG(J+KCGX2) = CG(LCGFAC+KCGX2)
100         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
101      +                         CG(J+KCGY2) = CG(LCGFAC+KCGY2)
102         CG(J+KCGZ2) = H1
103         X1     = CG(J+KCGX2)
104         Y1     = CG(J+KCGY2)
105         J      = J + LCGEDG
106 *
107   110   IF (D2 .LT. EEWOR)              GOTO 120
108         CG(J+KCGAE) = XYHA(4,2)
109         CG(J+KCGX2) = X2
110         CG(J+KCGY2) = Y2
111         CG(J+KCGZ2) = H2
112         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
113      +                         CG(J+KCGX1) = X2*COSDA(K) - Y2*SINDA(K)
114         IF (I.NE.NASTP(K) .OR.  IFULL.EQ.0)
115      +                         CG(J+KCGY1) = X2*SINDA(K) + Y2*COSDA(K)
116         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
117      +                         CG(J+KCGX1) = CG(LCGFAC+KCGX1)
118         IF (I.EQ.NASTP(K) .AND. IFULL.NE.0)
119      +                         CG(J+KCGY1) = CG(LCGFAC+KCGY1)
120         CG(J+KCGZ1) = H2
121         X2     = CG(J+KCGX1)
122         Y2     = CG(J+KCGY1)
123         J      = J + LCGEDG
124 *
125   120   CG(J+KCGAE) = ATREDG
126         IF (I.EQ.NASTP(K) .AND. IFULL.EQ.0)     CG(J+KCGAE) = 0.
127         CG(J+KCGX1) = X1
128         CG(J+KCGY1) = Y1
129         CG(J+KCGZ1) = H1
130         CG(J+KCGX2) = X2
131         CG(J+KCGY2) = Y2
132         CG(J+KCGZ2) = H2
133         J      = J + LCGEDG
134   130   CONTINUE
135       GOTO 999
136 *
137 **          M A K E   H O R I Z O N T A L   F A C E
138 *
139   200 DD     = D1 - D2
140       IF (ABS(DD) .LT. EEWOR)          GOTO 999
141       K1     = K
142       K2     = 3 - K
143       CG(J+KCGAF) = 0.
144       CG(J+KCGAA) = 0.
145       CG(J+KCGBB) = 0.
146       IF (DD .GT. 0)                    CG(J+KCGCC) = 1.
147       IF (DD .LT. 0)                    CG(J+KCGCC) =-1.
148       CG(J+KCGDD) =-XYHA(3,1) * CG(J+KCGCC)
149       NEDGE  = 0.
150       IF (D1 .GT. 0)                    NEDGE = NEDGE + NASTP(K1)
151       IF (D2 .GT. 0)                    NEDGE = NEDGE + NASTP(K2)
152       IF (IFULL .EQ. 0)                 NEDGE = NEDGE + 2
153       CG(J+KCGNE) = NEDGE
154       J      = J + LCGFAC
155       IF (IFULL .NE. 0)                 GOTO 210
156       CG(J+KCGAE) = 0.
157       CG(J+KCGX1) = X2
158       CG(J+KCGY1) = Y2
159       CG(J+KCGZ1) = H2
160       CG(J+KCGX2) = X1
161       CG(J+KCGY2) = Y1
162       CG(J+KCGZ2) = H1
163       J      = J + LCGEDG
164   210 IF (D1 .EQ. 0.)                    GOTO 230
165       DO 220 I=1,NASTP(K1)
166         CG(J+KCGAE) = XYHA(4,1)
167         CG(J+KCGX1) = X1
168         CG(J+KCGY1) = Y1
169         CG(J+KCGZ1) = H1
170         CG(J+KCGX2) = X1*COSDA(K1) - Y1*SINDA(K1)
171         CG(J+KCGY2) = X1*SINDA(K1) + Y1*COSDA(K1)
172         CG(J+KCGZ2) = H1
173         X1     = CG(J+KCGX2)
174         Y1     = CG(J+KCGY2)
175         J      = J + LCGEDG
176   220   CONTINUE
177       IF (IFULL .EQ. 0)                  GOTO 230
178       X1     = XYHA(1,1)*COSI - XYHA(2,1)*SINI
179       Y1     = XYHA(1,1)*SINI + XYHA(2,1)*COSI
180       CG(J-LCGEDG+KCGX2) = X1
181       CG(J-LCGEDG+KCGY2) = Y1
182 *
183   230 IF (D2 .EQ. 0.)                    GOTO 250
184       DO 240 I=1,NASTP(K2)
185         CG(J+KCGAE) = XYHA(4,2)
186         CG(J+KCGX2) = X2
187         CG(J+KCGY2) = Y2
188         CG(J+KCGZ2) = H2
189         CG(J+KCGX1) = X2*COSDA(K2) - Y2*SINDA(K2)
190         CG(J+KCGY1) = X2*SINDA(K2) + Y2*COSDA(K2)
191         CG(J+KCGZ1) = H2
192         X2     = CG(J+KCGX1)
193         Y2     = CG(J+KCGY1)
194         J      = J + LCGEDG
195   240   CONTINUE
196       IF (IFULL .EQ. 0)                  GOTO 250
197       X2     = XYHA(1,2)*COSI - XYHA(2,2)*SINI
198       Y2     = XYHA(1,2)*SINI + XYHA(2,2)*COSI
199       CG(J-LCGEDG+KCGX1) = X2
200       CG(J-LCGEDG+KCGY1) = Y2
201 *
202   250 IF (IFULL .NE. 0)                 GOTO 999
203       CG(J+KCGAE) = 0.
204       CG(J+KCGX1) = X1
205       CG(J+KCGY1) = Y1
206       CG(J+KCGZ1) = H1
207       CG(J+KCGX2) = X2
208       CG(J+KCGY2) = Y2
209       CG(J+KCGZ2) = H2
210       J      = J + LCGEDG
211 *
212   999 LCG    = J
213       RETURN
214       END