GEANT321/gdraw/gdcgsl.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:21  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GDCGSL(IVOLNA,ISHAPE)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       This routine allows computes the coefficients of the     *
  17 C.    *       cut plane and the limits and array of the clipping       *
  18 C.    *       volumes (boxes, cones, tubes, spheres).                  *
  19 C.    *                                                                *
  20 C.    *    ==>Called by : GDRAW                                        *
  21 C.    *                                                                *
  22 C.    *       Authors :  J.Salt ; S.Giani                              *
  23 C.    ******************************************************************
  24 C.
  25 #include "geant321/gcdraw.inc"
  26 #include "geant321/gcunit.inc"
  27 #include "geant321/gconsp.inc"
  28 #include "geant321/gcgobj.inc"
  29 *
  30 *
  31 *****SG
  32 *
  33 #include "geant321/gcspee.inc"
  34 #include "geant321/gcbank.inc"
  35 #include "geant321/gcnum.inc"
  36 #include "geant321/gcvolu.inc"
  37 #include "geant321/gchiln.inc"
  38 #include "geant321/gcmutr.inc"
  39 #include "geant321/pawc.inc"
  40 *
  41       DIMENSION TMIN(3),TMAX(3),XZ(2,4)
  42       CHARACTER*4 NACA
  43 *
  44       CALL UCTOH('PERS',IPERS,4,4)
  45       IF(IHOLE.NE.0)THEN
  46 *
  47 *   Clipping Volumes Creation
  48 *
  49 *   Look for volume to be clipped
  50 *
  51          NAIN=0
  52          JJJ=0
  53          ICUBE=0
  54          CALL UHTOC(IVOLNA,4,NACA,4)
  55          DO 30  III=1,MULTRA
  56             INV=0
  57             IWILDC=INDEX(GNNVV(III),'*')
  58             IF(IWILDC.EQ.0) THEN
  59                CALL UCTOH(GNNVV(III),INV,4,4)
  60             ELSEIF(IWILDC.EQ.1.AND.JJJ.LT.2) THEN
  61                INV=IVOLNA
  62             ELSEIF(GNNVV(III)(1:IWILDC-1).EQ.
  63      +                NACA(1:IWILDC-1)) THEN
  64                INV=IVOLNA
  65             ENDIF
  66             IF(INV.EQ.IVOLNA)THEN
  67 *
  68 *   If you find it, compute number of times it's to be clipped
  69 *   and set parameters of relative clipping shapes
  70 *
  71                JJJ=JJJ+1
  72                IF(JJJ.EQ.3)THEN
  73                   WRITE(CHMAIL,10100)
  74                   CALL GMAIL(0,0)
  75                   GOTO 60
  76                ENDIF
  77                IF(GNASH(III).EQ.'BOX ')THEN
  78                   DBX=GXMAX(III)-GXMIN(III)
  79                   DBY=GYMAX(III)-GYMIN(III)
  80                   DBZ=GZMAX(III)-GZMIN(III)
  81 *
  82                   IF(JJJ.EQ.2)THEN
  83                      ICUBE=ICUBE+1
  84                      CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP2))
  85                      CALL CGCEV(-1,Q(ICLIP2))
  86                      CALL CGCEV(-1,Q(ICLIP2))
  87                      CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
  88      +               Q(ICLIP2))
  89                      CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
  90 *   Perspective view
  91                      IF (IPRJ.EQ.IPERS) THEN
  92                         CALL CGPERS(Q(ICLIP2))
  93                      ENDIF
  94                   ELSE
  95                      ICUBE=ICUBE+1
  96                      CALL CGBRIK(DBX,DBY,DBZ,300,Q(ICLIP1))
  97                      CALL CGCEV(-1,Q(ICLIP1))
  98                      CALL CGCEV(-1,Q(ICLIP1))
  99                      CALL CGSHIF(GXMIN(III),GYMIN(III),GZMIN(III),
 100      +               Q(ICLIP1))
 101                      CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
 102 *   Perspective view
 103                      IF (IPRJ.EQ.IPERS) THEN
 104                         CALL CGPERS(Q(ICLIP1))
 105                      ENDIF
 106                   ENDIF
 107                ELSE IF (GNASH(III).EQ.'TUBE') THEN
 108                   RMIN1=0
 109                   RMAX1=GXMIN(III)
 110                   Z2=GXMAX(III)
 111                   RMIN2=RMIN1
 112                   RMAX2=RMAX1
 113                   XZ(1,1)=RMIN1
 114                   XZ(2,1)=-Z2
 115                   XZ(1,2)=RMAX1
 116                   XZ(2,2)=-Z2
 117                   XZ(1,3)=RMAX2
 118                   XZ(2,3)=Z2
 119                   XZ(1,4)=RMIN2
 120                   XZ(2,4)=Z2
 121                   ANG1=0.
 122                   ANG2=360.
 123                   NANG=30
 124 *
 125                   IF(JJJ.EQ.2)THEN
 126                      CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
 127                      CALL CGCEV(-1,Q(ICLIP2))
 128                      CALL CGCEV(-1,Q(ICLIP2))
 129                      S1=GYMIN(III)
 130                      S2=GYMAX(III)
 131                      S3=GZMIN(III)
 132                      CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
 133                      CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
 134 *   Perspective view
 135                      IF (IPRJ.EQ.IPERS) THEN
 136                         CALL CGPERS(Q(ICLIP2))
 137                      ENDIF
 138                   ELSE
 139                      CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
 140                      CALL CGCEV(-1,Q(ICLIP1))
 141                      CALL CGCEV(-1,Q(ICLIP1))
 142                      S1=GYMIN(III)
 143                      S2=GYMAX(III)
 144                      S3=GZMIN(III)
 145                      CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
 146                      CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
 147 *   Perspective view
 148                      IF (IPRJ.EQ.IPERS) THEN
 149                         CALL CGPERS(Q(ICLIP1))
 150                      ENDIF
 151                   ENDIF
 152                ELSE IF (GNASH(III).EQ.'SPHE') THEN
 153                   R=GXMIN(III)
 154                   NLAT=15
 155                   NLON=15
 156 *
 157                   IF(JJJ.EQ.2)THEN
 158                      CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP2))
 159                      CALL CGCEV(-1,Q(ICLIP2))
 160                      CALL CGCEV(-1,Q(ICLIP2))
 161                      S1=GXMAX(III)
 162                      S2=GYMIN(III)
 163                      S3=GYMAX(III)
 164                      CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
 165                      CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
 166 *   Perspective view
 167                      IF (IPRJ.EQ.IPERS) THEN
 168                         CALL CGPERS(Q(ICLIP2))
 169                      ENDIF
 170                   ELSE
 171                      CALL CGSPHE(R,NLAT,NLON,16000,Q(ICLIP1))
 172                      CALL CGCEV(-1,Q(ICLIP1))
 173                      CALL CGCEV(-1,Q(ICLIP1))
 174                      S1=GXMAX(III)
 175                      S2=GYMIN(III)
 176                      S3=GYMAX(III)
 177                      CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
 178                      CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
 179 *   Perspective view
 180                      IF (IPRJ.EQ.IPERS) THEN
 181                         CALL CGPERS(Q(ICLIP1))
 182                      ENDIF
 183                   ENDIF
 184                ELSE IF (GNASH(III).EQ.'CONE') THEN
 185                   RMIN1=0.
 186                   RMAX1=GXMIN(III)
 187                   RMIN2=0.
 188                   RMAX2=GXMAX(III)
 189                   Z2=GYMIN(III)
 190                   XZ(1,1)=RMIN1
 191                   XZ(2,1)=-Z2
 192                   XZ(1,2)=RMAX1
 193                   XZ(2,2)=-Z2
 194                   XZ(1,3)=RMAX2
 195                   XZ(2,3)=Z2
 196                   XZ(1,4)=RMIN2
 197                   XZ(2,4)=Z2
 198                   ANG1=0.
 199                   ANG2=360.
 200                   NANG=30
 201                   IF(JJJ.EQ.2)THEN
 202                      CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP2))
 203                      CALL CGCEV(-1,Q(ICLIP2))
 204                      CALL CGCEV(-1,Q(ICLIP2))
 205                      S1=GYMAX(III)
 206                      S2=GZMIN(III)
 207                      S3=GZMAX(III)
 208                      CALL CGSHIF(S1,S2,S3,Q(ICLIP2))
 209                      CALL CGMNMX(Q(ICLIP2),TMIN,TMAX)
 210 *   Perspective view
 211                      IF (IPRJ.EQ.IPERS) THEN
 212                         CALL CGPERS(Q(ICLIP2))
 213                      ENDIF
 214                   ELSE
 215                      CALL CGZREV(XZ,ANG1,ANG2,NANG,16000,Q(ICLIP1))
 216                      CALL CGCEV(-1,Q(ICLIP1))
 217                      CALL CGCEV(-1,Q(ICLIP1))
 218                      S1=GYMAX(III)
 219                      S2=GZMIN(III)
 220                      S3=GZMAX(III)
 221                      CALL CGSHIF(S1,S2,S3,Q(ICLIP1))
 222                      CALL CGMNMX(Q(ICLIP1),TMIN,TMAX)
 223 *   Perspective view
 224                      IF (IPRJ.EQ.IPERS) THEN
 225                         CALL CGPERS(Q(ICLIP1))
 226                      ENDIF
 227                   ENDIF
 228                ENDIF
 229 *          IF(CGERR.LE.0)THEN
 230 *             CALL GDCGER(CGERR)
 231 *             IF(KCGST.EQ.-2)GO TO 999
 232 *             IF(KCGST.EQ.-3)THEN
 233 *                WRITE(CHMAIL,10100)
 234 *                CALL GMAIL(0,0)
 235 *                GO TO 999
 236 *             ENDIF
 237 *          ENDIF
 238 *
 239 *    Compute scope for each clipping volume
 240 *
 241                DO 10 K=1,3
 242                   KKK=K+3*JJJ-3
 243                   BMIN(KKK)=TMIN(K)
 244                   BMAX(KKK)=TMAX(K)
 245    10          CONTINUE
 246                IF(IPORLI.EQ.1)THEN
 247                   DO 20 KJ=1,3
 248                      KKKJ=KJ+3*JJJ-3
 249                      CLIPMI(KKKJ)=TMIN(KJ)
 250                      CLIPMA(KKKJ)=TMAX(KJ)
 251    20             CONTINUE
 252                ENDIF
 253             ENDIF
 254    30    CONTINUE
 255 *
 256 *    If volume is not to be clipped
 257 *
 258          IF(JJJ.EQ.0)THEN
 259             IF(IPORLI.EQ.1)THEN
 260                DO 40 KJ=1,6
 261                   CLIPMI(KJ)=-10000
 262                   CLIPMA(KJ)=-9999
 263    40          CONTINUE
 264                JPORJJ=1
 265             ENDIF
 266             NAIN=1
 267             GOTO 60
 268          ELSE
 269             IF(IPORLI.EQ.1)THEN
 270                JPORJJ=JJJ
 271             ENDIF
 272             NAIN=2
 273             ISA=0
 274             DO 50  J=1,6
 275                IF(BMIN(J).EQ.CLIPMI(J).AND.BMAX(J).EQ.CLIPMA(J))THEN
 276                   ISA=ISA+1
 277                ENDIF
 278    50       CONTINUE
 279             IF(ISA.EQ.6)NAIN=3
 280          ENDIF
 281 *
 282 *
 283 *****SG
 284 *
 285 *
 286       ELSE
 287 *
 288 *   Slicing with a plane
 289 *
 290          IF(ICUT.EQ.0) GO TO 999
 291          IF(ICUT.EQ.1)THEN
 292             CTHETA=90.
 293             CPHI=180.
 294          ELSE IF(ICUT.EQ.2)THEN
 295             CTHETA=90.
 296             CPHI=270.
 297          ELSE IF(ICUT.EQ.3)THEN
 298             CTHETA=180.
 299             CPHI=0.
 300          ELSE
 301             WRITE(CHMAIL,10000)
 302             CALL GMAIL(0,0)
 303             GO TO 999
 304          ENDIF
 305          ATH=DEGRAD*CTHETA
 306          APH=DEGRAD*CPHI
 307          ABCD(1)=SIN(ATH)*COS(APH)
 308          ABCD(2)=SIN(ATH)*SIN(APH)
 309          ABCD(3)=COS(ATH)
 310          ABCD(4)=DCUT
 311       ENDIF
 312    60 CONTINUE
 313 *
 314 10000 FORMAT(' CUT Index not implemented')
 315 *10100 FORMAT(' Check Clipping Box Parameters ')
 316 10100 FORMAT(' Please, reset CVOL mode. ')
 317 *
 318   999 END