Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdcgcl.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:20  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.25  by  S.Giani
11 *-- Author :
12       SUBROUTINE GDCGCL(ISHAPE)
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *       This Subroutine allows the clipping of a CG object       *
17 C.    *       built with the Hidden Line Removal by means of any       *
18 C.    *       kind of shape (moreover it's possible to clip the        *
19 C.    *       same object more than once and by different shapes)      *
20 C.    *       defined by 'MCVOL' Command.                              *
21 C.    *                                                                *
22 C.    *    ==>Called by :  GDCGHI                                      *
23 C.    *                                                                *
24 C.    *       Authors :  J.Salt ; S.Giani     *********                *
25 C.    *                                                                *
26 C.    ******************************************************************
27 C
28 #include "geant321/gcbank.inc"
29 #include "geant321/gcgobj.inc"
30 #include "geant321/gchiln.inc"
31 #include "geant321/gcspee.inc"
32 #include "geant321/gcmutr.inc"
33 *
34       DIMENSION VMIN(3),VMAX(3)
35 *
36 *
37 *     Volume substraction. The algorithm is the following :
38 *
39 *     Check if the Clipping volume is inside Volume 'I' (First Check)
40 *
41 *      a) If Yes , Volume 'I' is Seen (IVFUN=1)
42 *      b) If Not , Check the following 3 cases (Second Check):
43 *
44 *          1) C. Vol. intersects volume 'I', but the volume does not include it
45 *              (IVFUN=2).
46 *          2) Volume 'I' is inside C. Vol., Then Volume is Unseen (IVFUN=0)
47 *          3) Volume 'I' is outside C. Vol., Then Volume is Seen (IVFUN=1)
48 *
49 *SG
50       IA=JCGOBJ+1
51       IB=JCGOBJ+8000
52 *SG
53       CALL CGMNMX(Q(IA),VMIN,VMAX)
54 *
55 *      First Check
56 *
57 ***SG
58 *
59       IF(NAIN.EQ.1)THEN
60         ISUB=JCGOBJ+20000
61         IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99)THEN
62           CALL CGCOPY(Q(IB),8000,Q(ISUB))
63         ELSE
64           CALL CGCOPY(Q(IA),8000,Q(ISUB))
65         ENDIF
66         RETURN
67       ENDIF
68 *
69 *      Do it for all the volumes cutting 'I'
70 *
71       DO 11 IJ=1,JJJ
72       DO 10 K=1,3
73          IF(VMIN(K).LE.BMIN(K+3*IJ-3).AND.BMIN(K+3*IJ-3).LE.VMAX(K).AND.
74      +VMIN(K).LE.BMAX(K+3*IJ-3).AND.BMAX(K+3*IJ-3).LE.VMAX(K))THEN
75 ***SG
76             GOTO 10
77          ELSE
78             GOTO 20
79          ENDIF
80    10 CONTINUE
81       IVFUN=1
82       GOTO 50
83 *
84 *      C. Vol. is not inside 'I'  Volume. Second Check:
85 ***SG
86 *
87    20 IKON=0
88       IDISJ=0
89       DO 30 J=1,3
90 ******         IDISJ=0
91 *      Do it for all the volumes cutting 'I'
92 *
93          IF(BMIN(J+3*IJ-3).LE.VMIN(J).AND.VMIN(J).LE.BMAX(J+3*IJ-3))THEN
94             IKON=IKON+1
95          ELSE
96             IDISJ=IDISJ+1
97          ENDIF
98          IF(BMIN(J+3*IJ-3).LE.VMAX(J).AND.VMAX(J).LE.BMAX(J+3*IJ-3))THEN
99 ***SG
100             IKON=IKON+1
101          ELSE
102             IDISJ=IDISJ+1
103          ENDIF
104          IF(IDISJ.EQ.6)GOTO 40
105    30 CONTINUE
106    40 IF(IDISJ.EQ.6)THEN
107          IVFUN=1
108       ELSE
109          IF(IKON.EQ.6)THEN
110           IF(ICUBE.EQ.JJJ)THEN
111 **            IVFUN=0
112              IVFUN=2
113           ELSE
114             IVFUN=2
115           ENDIF
116          ELSE
117             IVFUN=2
118          ENDIF
119       ENDIF
120    50 CONTINUE
121 **      IF(IVFUN.EQ.0)GOTO 11
122 *
123 *****SG
124 *
125 *    Multiple clipping: you can clip, as a sequence, the same
126 *    volume by two different shapes
127 *
128       IF(JJJ.EQ.2)THEN
129         ISUB1=JCGOBJ+12000
130         ISUB =JCGOBJ+20000
131         IF(IJ.EQ.1)THEN
132          IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99)THEN
133            IF(IVFUN.EQ.2) CALL CGSUB(Q(IB),Q(ICLIP1),8000,Q(ISUB1))
134            IF(IVFUN.EQ.1) CALL CGCOPY(Q(IB),8000,Q(ISUB1))
135          ELSE
136            IF(IVFUN.EQ.2) CALL CGSUB(Q(IA),Q(ICLIP1),8000,Q(ISUB1))
137            IF(IVFUN.EQ.1) CALL CGCOPY(Q(IA),8000,Q(ISUB1))
138          ENDIF
139         ENDIF
140         IF(IJ.EQ.2)THEN
141           IF(IVFUN.EQ.2) CALL CGSUB(Q(ISUB1),Q(ICLIP2),8000,Q(ISUB))
142           IF(IVFUN.EQ.1) CALL CGCOPY(Q(ISUB1),8000,Q(ISUB))
143         ENDIF
144       ELSE
145         ISUB=JCGOBJ+20000
146         IF(ISHAPE.EQ.29.OR.ISHAPE.EQ.99)THEN
147           IF(IVFUN.EQ.2) CALL CGSUB(Q(IB),Q(ICLIP1),8000,Q(ISUB))
148           IF(IVFUN.EQ.1) CALL CGCOPY(Q(IB),8000,Q(ISUB))
149         ELSE
150           IF(IVFUN.EQ.2) CALL CGSUB(Q(IA),Q(ICLIP1),8000,Q(ISUB))
151           IF(IVFUN.EQ.1) CALL CGCOPY(Q(IA),8000,Q(ISUB))
152         ENDIF
153       ENDIF
154    11 CONTINUE
155 *
156 *****SG
157 *
158       END