712c17ffcbb992c5824341f8792550f51da2a961
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gflcar.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:48  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
11 *-- Author :
12       SUBROUTINE GFLCAR(IAXIS,ISH,IROT,PARS,CL,CH,IERR)
13 C.
14 C.    *****************************************************************
15 C.    *                                                               *
16 C.    *    ROUTINE TO FIND THE LIMITS ALONG AXIS IAXIS IN CARTESIAN   *
17 C.    *    COORDINATES FOR VOLUME OF SHAPE ISH ROTATED BY THE         *
18 C.    *    ROTATION MATRIX IROT. THE SHAPE HAS NPAR PARAMETERS IN     *
19 C.    *    THE ARRAY PARS. THE LOWER LIMIT IS RETURNED IN CL, THE     *
20 C.    *    HIGHER IN CH. IF THE CALCULATION CANNOT BE MADE IERR IS    *
21 C.    *    SET TO 1 OTHERWISE IT IS SET TO 0.                         *
22 C.    *                                                               *
23 C.    *    ==>Called by : GFCLIM                                      *
24 C.    *         Author  A.McPherson  *********                        *
25 C.    *                                                               *
26 C.    *****************************************************************
27 C.
28 #include "geant321/gcbank.inc"
29 #include "geant321/gconsp.inc"
30 #include "geant321/gcshno.inc"
31       DIMENSION PARS(11),X(3),XT(3)
32 C.
33 C.          ---------------------------------------------------
34 C.
35       IERR=1
36       IF (ISH.GT.4.AND.ISH.NE.10.AND.ISH.NE.28) GO TO 40
37 C
38 C           CUBOIDS, TRAPEZOIDS, PARALLELEPIPEDS.
39 C
40 C
41       IERR=0
42       CL=0
43       CH=0
44 C
45       DO 30 IP=1,8
46 C
47 C           THIS IS A LOOP OVER THE 8 CORNERS.
48 C           FIRST FIND THE LOCAL COORDINATES.
49 C
50       IF(ISH.EQ.28) THEN
51 C
52 C            General twisted trapezoid.
53 C
54          IL=(IP+1)/2
55          I0=IL*4+11
56          IS=(IP-IL*2)*2+1
57          X(3)=PARS(1)*IS
58          X(1)=PARS(I0)+PARS(I0+2)*X(3)
59          X(2)=PARS(I0+1)+PARS(I0+3)*X(3)
60          GO TO 20
61 C
62       ENDIF
63 C
64       IP3=ISH+2
65       IF(ISH.EQ.10) IP3=3
66       IF(ISH.EQ.4) IP3=1
67       X(3)=PARS(IP3)
68       IF(IP.LE.4) X(3)=-X(3)
69       IP2=3
70       IF(ISH.GT.2.AND.X(3).GT.0.0) IP2=4
71       IF(ISH.EQ.1.OR.ISH.EQ.10) IP2=2
72       IF(ISH.EQ.4) IP2=4
73       IF(ISH.EQ.4.AND.X(3).GT.0.0) IP2=8
74       X(2)=PARS(IP2)
75       IF(MOD(IP+3,4).LT.2) X(2)=-X(2)
76       IP1=1
77       IF(ISH.NE.1.AND.ISH.NE.10.AND.X(3).GT.0.0) IP1=2
78       IF(ISH.EQ.4) IP1=5
79       IF(ISH.EQ.4.AND.X(3).GT.0.0) IP1=IP1+4
80       IF(ISH.EQ.4.AND.X(2).GT.0.0) IP1=IP1+1
81       X(1)=PARS(IP1)
82       IF(MOD(IP,2).EQ.1) X(1)=-X(1)
83 C
84       IF(ISH.NE.10) GO TO 10
85       X(1)=X(1)+X(2)*PARS(4)+X(3)*PARS(5)
86       X(2)=X(2)+X(3)*PARS(6)
87    10 CONTINUE
88 C
89       IF(ISH.NE.4) GO TO 20
90       IP4=7
91       IF(X(3).GT.0.0) IP4=11
92       X(1)=X(1)+X(2)*PARS(IP4)+X(3)*PARS(2)
93       X(2)=X(2)+X(3)*PARS(3)
94    20 CONTINUE
95 C
96 C          ROTATE.
97 C
98       JROT=LQ(JROTM-IROT)
99       XT(1)=X(1)
100       XT(2)=X(2)
101       XT(3)=X(3)
102       IF(IROT.NE.0) CALL GINROT(X,Q(JROT+1),XT)
103 C
104 C          UPDATE LIMITS IF NECESSARY.
105 C
106       IF(XT(IAXIS).LT.CL) CL=XT(IAXIS)
107       IF(XT(IAXIS).GT.CH) CH=XT(IAXIS)
108 C
109    30 CONTINUE
110 C
111       GO TO 999
112 C
113    40 CONTINUE
114       IF(ISH.EQ.9) GO TO 90
115 C
116 C              TUBES , CONES, POLYGONS, POLYCONES.
117 C              AND CUT TUBES.
118 C
119       X(1)=0.0
120       X(2)=0.0
121       X(3)=1.0
122       JROT=LQ(JROTM-IROT)
123       XT(1)=X(1)
124       XT(2)=X(2)
125       XT(3)=X(3)
126       IF(IROT.NE.0) CALL GINROT(X,Q(JROT+1),XT)
127 C
128 C          XT IS Z AXIS ROTATED.
129 C
130       IF(ABS(XT(IAXIS)).LT.0.99) GO TO 50
131       IF(ISH.EQ.11)GO TO 45
132       IF(ISH.EQ.12)GO TO 46
133 C
134 C           PARALLEL.
135 C
136       IP=3
137       IF(ISH.GT.6.AND.ISH.NE.NSCTUB.AND.ISH.NE.13.AND.ISH.NE.14) IP=1
138       CL=-PARS(IP)
139       CH=PARS(IP)
140       IERR=0
141 C
142       GO TO 999
143   45  NZLAST=PARS(4)
144       IZLAST=2+3*NZLAST
145       CL=PARS(5)
146       GO TO 49
147 C
148   46  NZLAST=PARS(3)
149       IZLAST=1+3*NZLAST
150       CL=PARS(4)
151 C
152   49  CH=PARS(IZLAST)
153       IF ( ABS(XT(IAXIS)-X(IAXIS)) .GT.1.) THEN
154          TEMP = CL
155          CL = -CH
156          CH = -TEMP
157       ENDIF
158       IERR=0
159       GO TO 999
160 C
161    50 CONTINUE
162 **
163       IF(ISH.EQ.13) THEN
164          CL=-PARS(IAXIS)
165          CH=PARS(IAXIS)
166          IERR=0
167          GOTO 999
168       ENDIF
169 **
170       IF(ISH.EQ.14) THEN
171 C     for hyperboloid, use escribed cylinder
172          CH = SQRT(PARS(2)**2+(PARS(3)*TAN(PARS(4)*DEGRAD))**2)
173          CL = -CH
174          IERR=0
175          GOTO 999
176       ENDIF
177 **
178       IF(ISH.GT.10.AND.ISH.NE.NSCTUB)GO TO 999
179       IF(ABS(XT(IAXIS)).GT.0.01) GO TO 70
180 C
181 C         Z AXIS PERPENDICULAR TO IAXIS. ASSUME COMPLETE TUBE OR
182 C         CONE (I.E. IGNORE PHI SEGMENTATION).
183 C
184       IF(ISH.GT.6.AND.ISH.NE.NSCTUB) GO TO 60
185 C
186       CL=-PARS(2)
187       CH=PARS(2)
188       IERR=0
189 C
190       GO TO 999
191 C
192    60 CONTINUE
193 C
194       RM=PARS(3)
195       IF(PARS(5).GT.PARS(3)) RM=PARS(5)
196 C
197       CL=-RM
198       CH=RM
199       IERR=0
200 C
201       GO TO 999
202 C
203    70 CONTINUE
204 C
205 C           ARBITRARY ROTATION.
206 C
207       DZ=PARS(3)
208       RM=PARS(2)
209       IF(ISH.EQ.13) THEN
210 **
211 **       approxime to a cylinder whit radius
212 **       equal to the ellipse major axis
213 **
214          IF(PARS(1).GT.RM) RM=PARS(1)
215          GOTO 80
216       ENDIF
217 **
218       IF(ISH.EQ.14) THEN
219         RM = SQRT(PARS(2)**2+(PARS(3)*TAN(PARS(4)*DEGRAD))**2)
220         GO TO 80
221       ENDIF
222 *
223       IF(ISH.EQ.NSCTUB) THEN
224         S1 = (1.0-PARS(8))*(1.0+PARS(8))
225         IF( S1 .GT. 0.0) S1 = SQRT(S1)
226         S2 = (1.0-PARS(11))*(1.0+PARS(11))
227         IF( S2 .GT. 0.0) S2 = SQRT(S2)
228         IF( S2 .GT. S1 ) S1 = S2
229         DZ = DZ+RM*S1
230       ENDIF
231       IF(ISH.LE.6) GO TO 80
232 C
233       DZ=PARS(1)
234       RM=PARS(3)
235       IF(PARS(5).GT.RM) RM=PARS(5)
236 C
237    80 CONTINUE
238 C
239       COST=ABS(XT(IAXIS))
240       SINT=(1+COST)*(1-COST)
241       IF(SINT.GT.0.0) SINT=SQRT(SINT)
242 C
243       CH=COST*DZ+SINT*RM
244       CL=-CH
245       IERR=0
246 C
247       GO TO 999
248    90 CONTINUE
249 C
250 C           SPHERE - ASSUME COMPLETE SPHERE, TAKE OUTER RADIUS.
251 C
252       IERR=0
253       CL=-PARS(2)
254       CH=PARS(2)
255 C
256   999 CONTINUE
257       END