GEANT321/ggeom/ggvchk.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:50  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.29  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GGVCHK (JVOM, IN, NVAR, LVAR)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    SUBR. GGVCHK (JVOM, IN, NVAR*, LVAR*)                       *
  17 C.    *                                                                *
  18 C.    *   Checks volume parameters of IN'th content of mother volume   *
  19 C.    *    at address JVOM or, when IN = 0, of mother volume itself.   *
  20 C.    *   Returns NVAR = 0, when no variable parameters                *
  21 C.    *       or  NVAR =-1, when no variable parameters AND not a      *
  22 C.    *        possible source of local development                    *
  23 C.    *       otherwise,                                               *
  24 C.    *        the list LVAR of the NVAR variable parameters positions *
  25 C.    *                                                                *
  26 C.    *   Called by : GGDVLP                                           *
  27 C.    *   Author    : F.Bruyant                                        *
  28 C.    *                                                                *
  29 C.    ******************************************************************
  30 C.
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/gcunit.inc"
  33 #include "geant321/gcshno.inc"
  34 C.
  35       DIMENSION LVAR(*)
  36       INTEGER   LDP(7,12), NDP(12)
  37       SAVE LDP,NDP
  38 C.
  39       DATA NDP/ 3, 4, 5, 7, 3, 3, 5, 5, 4, 3, 2, 2 /
  40       DATA LDP/ 1, 2, 3, 4*0,  1, 2, 3, 4, 3*0,  1, 2, 3, 4, 5, 2*0,
  41      +        1, 4, 5, 6, 8, 9, 10,  1, 2, 3, 4*0,  1, 2, 3, 4*0,
  42      +        1, 2, 3, 4, 5, 2*0,  1, 2, 3, 4, 5, 2*0,  1, 2, 3, 4, 3*0,
  43      +        1, 2, 3, 4*0,  2, 3, 5*0,  2, 3, 5*0 /
  44 C.
  45 C.    ------------------------------------------------------------------
  46 *
  47       NVAR = 0
  48       NSP  = 0
  49       IF (IN.EQ.0) THEN
  50          NPAR = Q(JVOM+5)
  51          IF (NPAR.LE.0) THEN
  52             NIN = Q(JVOM+3)
  53             IF (NIN.LT.0) NVAR = -1
  54             GO TO 999
  55          ENDIF
  56          JPAR = JVOM +6
  57          ISH = Q(JVOM+2)
  58       ELSE
  59          JIN  = LQ(JVOM-IN)
  60          IVO  = Q(JIN+2)
  61          JVO  = LQ(JVOLUM-IVO)
  62          NPAR = Q(JVO+5)
  63          IF (NPAR.GT.0) THEN
  64             JPAR = JVO +6
  65          ELSE
  66             NIN  = Q(JVOM+3)
  67             IF (NIN.LT.0) THEN
  68                JPAR = 0
  69             ELSE
  70                JPAR = JIN +9
  71                NIN  = Q(JVO+3)
  72                IF (NIN.LT.0) THEN
  73                   NSP = -1
  74                ELSE
  75 *
  76                   DO 9 IIN = 1, NIN
  77                      JJIN = LQ(JVO-IIN)
  78                      IIVO = Q(JJIN+2)
  79                      JJVO = LQ(JVOLUM-IIVO)
  80                      NNPAR= Q(JJVO+5)
  81                      IF (NNPAR.GT.0) THEN
  82                         JJPAR= JJVO + 6
  83                      ELSE
  84                         NSP=-1
  85                         GO TO 10
  86                      ENDIF
  87 *
  88                      IISH = Q(JJVO+2)
  89                      NND  = NDP(IISH)
  90                      IF (IISH.LE.10) THEN
  91 *
  92 *   *                  Volumes other than PGON or PCON
  93 *
  94                         DO 6 ID = 1,NND
  95                            IIDP = LDP(ID,IISH)
  96                            IF (Q(JJPAR+IIDP).LT.0.) THEN
  97                               NSP = -1
  98                               GO TO 10
  99                            ENDIF
 100     6                   CONTINUE
 101 *
 102                      ELSE IF (IISH.LE.12) THEN
 103 *
 104 *   *                  PGON and PCON volumes
 105 *
 106                         IPZ  = 15 -IISH
 107                         JJPAR = JJPAR +IPZ
 108                         NNZ   = 2*Q(JJPAR)
 109                         DO 8 IZ = 1, NNZ
 110                            DO 7 ID = 1, NND
 111                               IIDP = LDP(ID,IISH)
 112                               IF (Q(JJPAR+IIDP).LT.0.) THEN
 113                                  NSP = -1
 114                                  GO TO 10
 115                               ENDIF
 116     7                      CONTINUE
 117     8                   CONTINUE
 118                      ENDIF
 119     9             CONTINUE
 120 *
 121                ENDIF
 122 *
 123             ENDIF
 124          ENDIF
 125   10     ISH = Q(JVO+2)
 126       ENDIF
 127 *        Shape 28 will not be supported in the future
 128       IF (ISH.EQ.28.OR.ISH.EQ.13.OR.ISH.EQ.NSCTUB.OR.ISH.EQ.14)THEN
 129          NVAR = 0
 130          GO TO 999
 131       ENDIF
 132 *
 133       ND = NDP(ISH)
 134 *
 135       IF (JPAR.LE.0) THEN
 136          IF (ISH.LE.10) THEN
 137 *
 138 *  *       Volumes other PGON or PCON
 139 *
 140             NVAR = ND
 141             DO 11 ID = 1, ND
 142    11       LVAR(ID) = LDP(ID,ISH)
 143          ELSE IF (ISH.LE.12) THEN
 144 *
 145 *  *       PGON and PCON volumes
 146 *
 147             IPZ  = 15 - ISH
 148             NVAR = 6
 149             DO 12 ID = 1, NVAR
 150    12       LVAR(ID) = IPZ + ID
 151          ELSE
 152 *
 153             GO TO 900
 154          ENDIF
 155          GO TO 999
 156       ENDIF
 157 *
 158       IF (ISH.LE.10) THEN
 159 *
 160 *   *   Volumes other than PGON or PCON
 161 *
 162          DO 19 ID = 1,ND
 163             IDP = LDP(ID,ISH)
 164             IF (Q(JPAR+IDP).GE.0.) GO TO 19
 165             NVAR = NVAR +1
 166             LVAR(NVAR) = IDP
 167    19    CONTINUE
 168 *
 169       ELSE IF (ISH.LE.12) THEN
 170 *
 171 *   *   PGON and PCON volumes
 172 *
 173          IPZ  = 15 -ISH
 174          JPAR = JPAR +IPZ
 175          NZ   = 2*Q(JPAR)
 176          INC  = IPZ
 177          DO 29 IZ = 1,NZ
 178             DO 28 ID = 1,ND
 179                IDP = LDP(ID,ISH)
 180                IF (Q(JPAR+IDP).GE.0.) GO TO 28
 181                NVAR = NVAR +1
 182                LVAR(NVAR) = INC +IDP
 183    28       CONTINUE
 184             INC = INC +3
 185    29    CONTINUE
 186       ELSE
 187 *
 188          GO TO 900
 189       ENDIF
 190       IF (NVAR.EQ.0) NVAR = NSP
 191       GO TO 999
 192 *
 193  900  WRITE (CHMAIL, 1001) ISH
 194       CALL GMAIL (0, 0)
 195  1001 FORMAT (' GGVCHK : No code for shape ISH=',I5)
 196 *                                                             END GGVCHK
 197  999  END