This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgelli.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:19:42  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 CGELLI(RX,RY,RZ,KA,KB,LCG,CG)
13 ************************************************************************
14 *                                                                      *
15 *     Name: CGELLI                                                     *
16 *     Author: E. Chernyaev                       Date:    24.01.89     *
17 *                                                Revised:              *
18 *                                                                      *
19 *     Function: Create CG-object for ELLIPSOID                         *
20 *                                                                      *
21 *     References: CGSIZE, CGSNOR                                       *
22 *                                                                      *
23 *     Input:  RX - 1-st radius                                         *
24 *             RY - 2-nd radius                                         *
25 *             RZ - 3-rd radius                                         *
26 *             KA - number of latitude step                             *
27 *             KB - number of longitude step                            *
28 *            LCG - max-size of CG-object                               *
29 *                                                                      *
30 *     Output: CG - CG-object                                           *
31 *                  CG(1) - length of CG-object                         *
32 *                        = 0 if error in parameters                    *
33 *                        < 0 if no space                               *
34 *                                                                      *
35 *     Errors: none                                                     *
36 *                                                                      *
37 ************************************************************************
38 #include "geant321/cggpar.inc"
39       REAL      CG(*)
40       INTEGER   NFAC(2),NEDG(2)
41 *-
42       CG(KCGSIZ)  = 0.
43 *           T E S T   P A R A M E T E R S   C O R R E C T N E S S
44       IF (RX .LE. 0.)   GOTO 999
45       IF (RY .LE. 0.)   GOTO 999
46       IF (RZ .LE. 0.)   GOTO 999
47       IF (KA .LT. 3)    GOTO 999
48       IF (KB .LT. 2)    GOTO 999
49 *           C O M P U T E   S I Z E   O F   C G - O B J E C T
50       NFATYP = 2
51       NFAC(1)= 2 * KA
52       NEDG(1)= 3
53       NFAC(2)= (KB - 2) * KA
54       NEDG(2)= 4
55       CG(KCGSIZ)  = CGSIZE(LCG,NFATYP,NFAC,NEDG)
56       IF (CG(KCGSIZ) .LE. 0.)        GOTO 999
57 *
58 **          C R E A T E   C G - O B J E C T   F O R   E L L I P S O I D
59 *
60       CG(KCGATT) = 0.
61       CG(KCGNF)  = NFAC(1) + NFAC(2)
62       PI     = ATAN(1.) * 4.
63       DA     = (PI+PI) / KA
64       DB     = PI / KB
65       JCOSB  = CG(KCGSIZ) - 2*(KB+KA) - 4
66       JSINB  = JCOSB + KB + 1
67       JCOSA  = JSINB + KB + 1
68       JSINA  = JCOSA + KA + 1
69 *           P R E P A R E   W O R K   T A B L E
70       A      = 0.
71       B      = 0.
72       JA     = 0
73       JB     = 0
74   100 CG(JCOSA+JA)     = COS(A)
75       CG(JCOSA+KA-JA)  = CG(JCOSA+JA)
76       CG(JSINA+JA)     = SIN(A)
77       CG(JSINA+KA-JA)  =-CG(JSINA+JA)
78       JA     = JA + 1
79       A      = A + DA
80       IF (KA-JA-JA) 200,110,100
81   110 CG(JCOSA+JA)     =-1.
82       CG(JSINA+JA)     = 0.
83 *
84   200 CG(JCOSB+JB)    = COS(B)
85       CG(JCOSB+KB-JB) =-CG(JCOSB+JB)
86       CG(JSINB+JB)    = SIN(B)
87       CG(JSINB+KB-JB) = CG(JSINB+JB)
88       JB     = JB + 1
89       B      = B + DB
90       IF (KB-JB-JB) 300,210,200
91   210 CG(JCOSB+JB)    = 0.
92       CG(JSINB+JB)    = 1.
93 *           C R E A T E   U P P E R   H A L F   O F   E L L I P S O I D
94   300 JCG    = LCGHEA
95       NB     = KB - KB/2
96       DO 500 JB=1,NB
97         Z1     = RZ*CG(JCOSB+JB-1)
98         Z2     = RZ*CG(JCOSB+JB)
99         X4     = RX*CG(JSINB+JB-1)
100         X3     = RX*CG(JSINB+JB)
101         Y4     = 0.
102         Y3     = 0.
103         DO 400 JA=1,KA
104           CG(JCG+KCGAF) = 0.
105           JCGNE  = JCG + KCGNE
106           JCG    = JCG + LCGFAC
107           X1     = X4
108           X2     = X3
109           X3     = RX*CG(JSINB+JB)   * CG(JCOSA+JA)
110           X4     = RX*CG(JSINB+JB-1) * CG(JCOSA+JA)
111           Y1     = Y4
112           Y2     = Y3
113           Y3     = RY*CG(JSINB+JB)   * CG(JSINA+JA)
114           Y4     = RY*CG(JSINB+JB-1) * CG(JSINA+JA)
115           CG(JCG+KCGAE) =-1.
116           CG(JCG+KCGX1) = X1
117           CG(JCG+KCGY1) = Y1
118           CG(JCG+KCGZ1) = Z1
119           CG(JCG+KCGX2) = X2
120           CG(JCG+KCGY2) = Y2
121           CG(JCG+KCGZ2) = Z2
122 *
123           CG(JCG+LCGEDG+KCGAE) =-1.
124           CG(JCG+LCGEDG+KCGX1) = X2
125           CG(JCG+LCGEDG+KCGY1) = Y2
126           CG(JCG+LCGEDG+KCGZ1) = Z2
127           CG(JCG+LCGEDG+KCGX2) = X3
128           CG(JCG+LCGEDG+KCGY2) = Y3
129           CG(JCG+LCGEDG+KCGZ2) = Z2
130 *
131           CG(JCG+LCGEDG+LCGEDG+KCGAE) =-1.
132           CG(JCG+LCGEDG+LCGEDG+KCGX1) = X3
133           CG(JCG+LCGEDG+LCGEDG+KCGY1) = Y3
134           CG(JCG+LCGEDG+LCGEDG+KCGZ1) = Z2
135           CG(JCG+LCGEDG+LCGEDG+KCGX2) = X4
136           CG(JCG+LCGEDG+LCGEDG+KCGY2) = Y4
137           CG(JCG+LCGEDG+LCGEDG+KCGZ2) = Z1
138           NE     = 3
139           IF(X1.EQ.X4 .AND. Y1.EQ.Y4) GOTO 350
140           NE     = 4
141           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGAE) =-1.
142           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGX1) = X4
143           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGY1) = Y4
144           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGZ1) = Z1
145           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGX2) = X1
146           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGY2) = Y1
147           CG(JCG+LCGEDG+LCGEDG+LCGEDG+KCGZ2) = Z1
148   350     JCG    = JCG + NE*LCGEDG
149           CG(JCGNE) = NE
150   400     CONTINUE
151   500   CONTINUE
152 *           C R E A T E   L O W E R   H A L F   O F   E L L I P S O I D
153       JSTOP  = JCG
154       JCGUP  = LCGHEA
155       JCGLOW = CG(KCGSIZ)
156   600 NE     = CG(JCGUP+KCGNE)
157       JCGLOW = JCGLOW - LCGFAC - NE*LCGEDG
158       IF (JCGLOW .LT. JSTOP)    GOTO 999
159       CG(JCGLOW+KCGAF) = CG(JCGUP+KCGAF)
160       CG(JCGLOW+KCGNE) = NE
161       JL     = JCGLOW + LCGFAC
162       JU     = JCGUP  + LCGFAC
163 *
164       CG(JL+KCGAE) = CG(JU+KCGAE)
165       CG(JL+KCGX1) = CG(JU+KCGX2)
166       CG(JL+KCGY1) = CG(JU+KCGY2)
167       CG(JL+KCGZ1) =-CG(JU+KCGZ2)
168       CG(JL+KCGX2) = CG(JU+KCGX1)
169       CG(JL+KCGY2) = CG(JU+KCGY1)
170       CG(JL+KCGZ2) =-CG(JU+KCGZ1)
171       JU = JU + (NE-1)*LCGEDG
172 *
173       CG(JL+LCGEDG+KCGAE) = CG(JU+KCGAE)
174       CG(JL+LCGEDG+KCGX1) = CG(JU+KCGX2)
175       CG(JL+LCGEDG+KCGY1) = CG(JU+KCGY2)
176       CG(JL+LCGEDG+KCGZ1) =-CG(JU+KCGZ2)
177       CG(JL+LCGEDG+KCGX2) = CG(JU+KCGX1)
178       CG(JL+LCGEDG+KCGY2) = CG(JU+KCGY1)
179       CG(JL+LCGEDG+KCGZ2) =-CG(JU+KCGZ1)
180 *
181       CG(JL+LCGEDG+LCGEDG+KCGAE) = CG(JU-LCGEDG+KCGAE)
182       CG(JL+LCGEDG+LCGEDG+KCGX1) = CG(JU-LCGEDG+KCGX2)
183       CG(JL+LCGEDG+LCGEDG+KCGY1) = CG(JU-LCGEDG+KCGY2)
184       CG(JL+LCGEDG+LCGEDG+KCGZ1) =-CG(JU-LCGEDG+KCGZ2)
185       CG(JL+LCGEDG+LCGEDG+KCGX2) = CG(JU-LCGEDG+KCGX1)
186       CG(JL+LCGEDG+LCGEDG+KCGY2) = CG(JU-LCGEDG+KCGY1)
187       CG(JL+LCGEDG+LCGEDG+KCGZ2) =-CG(JU-LCGEDG+KCGZ1)
188       IF (NE .EQ. 3)    GOTO 700
189 *
190       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGAE) = CG(JU-LCGEDG-LCGEDG+KCGAE)
191       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGX1) = CG(JU-LCGEDG-LCGEDG+KCGX2)
192       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGY1) = CG(JU-LCGEDG-LCGEDG+KCGY2)
193       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGZ1) =-CG(JU-LCGEDG-LCGEDG+KCGZ2)
194       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGX2) = CG(JU-LCGEDG-LCGEDG+KCGX1)
195       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGY2) = CG(JU-LCGEDG-LCGEDG+KCGY1)
196       CG(JL+LCGEDG+LCGEDG+LCGEDG+KCGZ2) =-CG(JU-LCGEDG-LCGEDG+KCGZ1)
197   700 JCGUP  = JCGUP + LCGFAC + NE*LCGEDG
198       GOTO 600
199 *
200   999 CALL CGSNOR(CG)
201       RETURN
202       END