GEANT321/ggeom/ggcave.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:49  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GGCAVE
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *   SUBR. GGCAVE                                                 *
  17 C.    *                                                                *
  18 C.    *   Decides whether a given volume is convex or concave.         *
  19 C.    *   For concave volumes, it sets up bit 3 of the status word     *
  20 C.    *   of the corresponding Volume bank                             *
  21 C.    *                                                                *
  22 C.    *   Called by : GGCLOS                                           *
  23 C.    *   Authors   : S.Banerjee                                       *
  24 C.    *                                                                *
  25 C.    ******************************************************************
  26 C.
  27 #include "geant321/gcbank.inc"
  28 C.
  29 C.    ------------------------------------------------------------------
  30 *
  31       IF (IQ(JVOLUM-1).LE.0) GO TO 999
  32 *
  33 * *** Loop over all volumes
  34 *
  35       DO 20 IVO = 1, IQ(JVOLUM-1)
  36          JVO = LQ(JVOLUM-IVO)
  37          ISH = Q(JVO+2)
  38 *
  39 *  **    Some volumes are always convex
  40 *
  41          IF (ISH.EQ.13)GO TO 20
  42          IF ((ISH.GT.0.AND.ISH.LE.4).OR.ISH.EQ.10) GO TO 20
  43 *
  44          IF (ISH.EQ.5.OR.ISH.EQ.6.OR.ISH.EQ.9) THEN
  45 *
  46 *  **       For TUBE/TUBS/SPHR, only when rmin is zero
  47 *  **       For      TUBS/SPHR, D(Phi) should be less than 180.0
  48 *
  49             IF (Q(JVO+5).GT.0.0) THEN
  50                IF (Q(JVO+7).EQ.0.0) THEN
  51                   IF (ISH.EQ.5) THEN
  52                      GO TO 20
  53                   ELSE IF (ISH.EQ.6) THEN
  54                      DPHI = Q(JVO+11) - Q(JVO+10)
  55                   ELSE
  56                      DPHI = Q(JVO+12) - Q(JVO+11)
  57                   ENDIF
  58                   IF (DPHI.LT.0.0) DPHI = DPHI + 360.0
  59                   IF (DPHI.LE.180.0.OR.DPHI.GE.360.0) GO TO 20
  60                ENDIF
  61             ENDIF
  62 *
  63          ELSE IF (ISH.EQ.7.OR.ISH.EQ.8) THEN
  64 *
  65 *  **       For CONE/CONS, only when rmin's are zero
  66 *  **       For      CONS, D(Phi) should be less than 180.0
  67 *
  68             IF (Q(JVO+5).GT.0.0) THEN
  69                IF (Q(JVO+8).EQ.0.0.AND.Q(JVO+10).EQ.0.0) THEN
  70                   IF (ISH.EQ.7) THEN
  71                      GO TO 20
  72                   ELSE
  73                      DPHI = Q(JVO+13) - Q(JVO+12)
  74                      IF (DPHI.LT.0.0) DPHI = DPHI + 360.0
  75                      IF (DPHI.LE.180.0.OR.DPHI.GE.360.0) GO TO 20
  76                   ENDIF
  77                ENDIF
  78             ENDIF
  79 *
  80          ELSE IF (ISH.EQ.11.OR.ISH.EQ.12) THEN
  81 *
  82 *  **       For PGON/PCON, only when rmin's are zero, has 2 z-planes
  83 *  **                      and D(phi) less than 180.0 or equal to 360.0
  84 *
  85             IF (Q(JVO+5).GT.0.0) THEN
  86                IF (ISH.EQ.11) THEN
  87                  IPZ  = 10
  88                ELSE
  89                  IPZ  = 9
  90                ENDIF
  91                NPZ  = Q(JVO+IPZ)
  92                DPHI = Q(JVO+8)
  93                IF (DPHI.LT.0.0) DPHI = DPHI + 360.0
  94                IF (NPZ.EQ.2.AND.Q(JVO+IPZ+2).EQ.0.0.AND.
  95      +             Q(JVO+IPZ+5).EQ.0.0) THEN
  96                   IF (DPHI.LE.180.0.OR.DPHI.GE.360.0) GO TO 20
  97                ENDIF
  98             ENDIF
  99 *
 100          ENDIF
 101 C    hyperboloids (ISH=14) are always concave
 102          IQ(JVO) = IBSET(IQ(JVO),2)
 103    20 CONTINUE
 104 *                                                             END GGCAVE
 105   999 END