| fe4da5cc |
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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame