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