]>
Commit | Line | Data |
---|---|---|
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 |