]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/cgpack/cgslic.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / cgpack / cgslic.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:19:44 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 CGSLIC(A,SLIC,NMAX,B)
13************************************************************************
14* *
15* Name: CGSLIC *
16* Author: E. Chernyaev Date: 20.04.89 *
17* Revised: *
18* *
19* Function: Make slice of CG-object *
20* *
21* References: CGMNMX *
22* *
23* Input: A(*) - CG-object *
24* SLIC(4) - slicing plane *
25* NMAX - max size of B-array *
26* *
27* Output: B - resulting CG-object *
28* *
29* Errors: none *
30* *
31************************************************************************
32#include "geant321/cggpar.inc"
33#include "geant321/cgdelt.inc"
34 PARAMETER (NWORK=LCGHEA+6*(LCGFAC+4*LCGEDG))
35 REAL A(*),B(*),SLIC(4),ABCD(4)
36 REAL RMN(3),RMX(3),RMID(3),W(NWORK),XYZ(3,8)
37*-
38 B(1) = 0.
39* 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
40 IF (NMAX .LT. LCGHEA) GOTO 999
41 S = SQRT(SLIC(1)*SLIC(1)+SLIC(2)*SLIC(2)+SLIC(3)*SLIC(3))
42 IF (S .LE. EEWOR) GOTO 999
43 ABCD(1)= SLIC(1) / S
44 ABCD(2)= SLIC(2) / S
45 ABCD(3)= SLIC(3) / S
46 ABCD(4)= SLIC(4) / S
47 CALL CGSCOP(1,A,RMN,RMX)
48* CALL CGMNMX(A,RMN,RMX)
49 IF (RMN(1) .GT. RMX(1)) GOTO 999
50* M I N - M A X T E S T
51 NFACE = A(KCGNF)
52 IF (NFACE .EQ. 0) GOTO 998
53 NPOS = 0
54 NNEG = 0
55 J = LCGHEA
56 DO 120 NF=1,NFACE
57 NEDGE = A(J+KCGNE)
58 J = J + LCGFAC
59 DO 110 NE=1,NEDGE
60 DIST = ABCD(1)*A(J+KCGX1)+ABCD(2)*A(J+KCGY1)
61 + +ABCD(3)*A(J+KCGZ1) + ABCD(4)
62 IF (DIST .GT.-EEWOR) NPOS = NPOS + 1
63 IF (DIST .LT.+EEWOR) NNEG = NNEG + 1
64 J = J + LCGEDG
65 110 CONTINUE
66 120 CONTINUE
67 IF (NPOS .EQ. 0) GOTO 998
68 IF (NNEG .EQ. 0) CALL CGCOPY(A,NMAX,B)
69 IF (NNEG .EQ. 0) GOTO 999
70* P R E P A R E S L I C I N G O B J E C T
71 K = 1
72 IF (ABS(ABCD(2)) .GT. ABS(ABCD(1))) K = 2
73 IF (ABS(ABCD(3)) .GT. ABS(ABCD(K))) K = 3
74 RMID(1) = (RMN(1)+RMX(1)) / 2.
75 RMID(2) = (RMN(2)+RMX(2)) / 2.
76 RMID(3) = (RMN(3)+RMX(3)) / 2.
77 RX = RMX(1) - RMN(1)
78 RY = RMX(2) - RMN(2)
79 RZ = RMX(3) - RMN(3)
80*
81 GOTO (210,220,230),K
82 210 XYZ(2,1) = RMID(2) + RY
83 XYZ(3,1) = RMID(3) + RZ
84 XYZ(2,2) = RMID(2) - RY
85 XYZ(3,2) = RMID(3) + RZ
86 XYZ(2,3) = RMID(2) - RY
87 XYZ(3,3) = RMID(3) - RZ
88 XYZ(2,4) = RMID(2) + RY
89 XYZ(3,4) = RMID(3) - RZ
90 DO 215 I=1,4
91 XYZ(1,I) = -(ABCD(2)*XYZ(2,I)+ABCD(3)*XYZ(3,I)+ABCD(4))/ABCD(1)
92 215 CONTINUE
93 GOTO 250
94*
95 220 XYZ(1,1) = RMID(1) + RX
96 XYZ(3,1) = RMID(3) + RZ
97 XYZ(1,2) = RMID(1) - RX
98 XYZ(3,2) = RMID(3) + RZ
99 XYZ(1,3) = RMID(1) - RX
100 XYZ(3,3) = RMID(3) - RZ
101 XYZ(1,4) = RMID(1) + RX
102 XYZ(3,4) = RMID(3) - RZ
103 DO 225 I=1,4
104 XYZ(2,I) = -(ABCD(1)*XYZ(1,I)+ABCD(3)*XYZ(3,I)+ABCD(4))/ABCD(2)
105 225 CONTINUE
106 GOTO 250
107*
108 230 XYZ(1,1) = RMID(1) + RX
109 XYZ(2,1) = RMID(2) + RY
110 XYZ(1,2) = RMID(1) - RX
111 XYZ(2,2) = RMID(2) + RY
112 XYZ(1,3) = RMID(1) - RX
113 XYZ(2,3) = RMID(2) - RY
114 XYZ(1,4) = RMID(1) + RX
115 XYZ(2,4) = RMID(2) - RY
116 DO 235 I=1,4
117 XYZ(3,I) = -(ABCD(1)*XYZ(1,I)+ABCD(2)*XYZ(2,I)+ABCD(4))/ABCD(3)
118 235 CONTINUE
119 GOTO 250
120*
121 250 IF (ABCD(K) .GT. 0) S = -3.
122 IF (ABCD(K) .LT. 0) S = +3.
123 RX = 0.
124 RY = 0.
125 RZ = 0.
126 IF (K .EQ. 1) RX = S * (RMX(1)-RMN(1))
127 IF (K .EQ. 2) RY = S * (RMX(2)-RMN(2))
128 IF (K .EQ. 3) RZ = S * (RMX(3)-RMN(3))
129 DO 255 I=1,4
130 XYZ(1,I+4) = XYZ(1,I) + RX
131 XYZ(2,I+4) = XYZ(2,I) + RY
132 XYZ(3,I+4) = XYZ(3,I) + RZ
133 255 CONTINUE
134 CALL CGBOX(XYZ,4,4,NWORK,W)
135 CALL CGCEV(1,W)
136* M A K E S L I C E
137 CALL CGSUB(A,W,NMAX,B)
138 GOTO 999
139*
140 998 B(KCGSIZ) = LCGHEA
141 B(KCGATT) = 0.
142 B(KCGNF) = 0.
143 999 RETURN
144 END