GEANT321/ghits/ggdetv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:10  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.20  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GGDETV (ISET, IDET)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *    Routine - to compute and store the list of volumes which    *
  17 C.    *    permit to identify uniquely any detector volume specified   *
  18 C.    *    by  the set number ISET, the detector number IDET and the   *
  19 C.    *    corresponding list of volume copy numbers                   *
  20 C.    *            - to compute and store the physical path(s) through *
  21 C.    *    the JVOLUM data structure down to the given detector volume *
  22 C.    *                                                                *
  23 C.    *    ==>Called by : GHCLOS                                       *
  24 C.    *         Author  F.Bruyant  *********                           *
  25 C.    *                                                                *
  26 C.    ******************************************************************
  27 C.
  28 #include "geant321/gcbank.inc"
  29 #include "geant321/gcflag.inc"
  30 #include "geant321/gcnum.inc"
  31 #include "geant321/gcunit.inc"
  32 C.
  33       PARAMETER (NLVMAX=15,NSKMAX=20,NVMAX=20)
  34       INTEGER  IVOSK(NSKMAX,NLVMAX-1), LIMUL(NLVMAX), LINAM(NLVMAX)
  35      +,        LIST(2), NSK(NLVMAX-1)
  36       EQUIVALENCE (LINAM(1),WS(1)), (LIMUL(1),WS(NLVMAX+1)), (IVOSK(1,1)
  37      +,   WS(2*NLVMAX+1)), (NSK(1),WS((NSKMAX+2)*(NLVMAX-1)+3))
  38      +,   (LIST(1),WS((NSKMAX+3)*(NLVMAX-1)+3))
  39 C.
  40 C.         -------------------------------------------------------------
  41 C.
  42       JS = LQ(JSET-ISET)
  43       JD = LQ(JS-IDET)
  44 C
  45 C     Check that JD bank has been created by GSDETV (not GSDET)
  46 C      or has not been already processed.
  47 C
  48       IF (IQ(JD+9).NE.-1) GO TO 999
  49       IQ(JD+9) = -2
  50       IHDET = IQ(JS+IDET)
  51       IF (IDEBUG.NE.0) THEN
  52          WRITE (CHMAIL, 1001) IHDET
  53          CALL GMAIL (0,0)
  54  1001    FORMAT (' GGDETV : Detector ',A4)
  55       ENDIF
  56 C
  57 C     Check that current detector is not an alias
  58 C
  59       IALI = IQ(JD+10)
  60       IF (IALI.NE.0) GO TO 200
  61       NSOL = 0
  62       NV = 0
  63
  64       NLIST = 0
  65       CALL VZERO (NSK, NLVMAX-1)
  66       NLEV = 1
  67       LINAM(1) = IHDET
  68       MULT1 = 1
  69    10 IVOS = IUCOMP (LINAM(NLEV), IQ(JVOLUM+1), NVOLUM)
  70 C
  71 C     Search for detector parents up to top of tree
  72 C
  73    20 IF (IVOS.EQ.1) GO TO 60
  74 C
  75       DO 40 IVO=1,NVOLUM
  76          IF (IVO.EQ.IVOS) GO TO 40
  77          JVO = LQ(JVOLUM-IVO)
  78          NIN = Q(JVO+3)
  79          IF (NIN.EQ.0) GO TO 40
  80          IF (NSOL.GT.0) THEN
  81 C           Skip mother banks already found
  82             IF (IUCOMP (IVO, IVOSK(1,NLEV), NSK(NLEV)) .NE. 0) GO TO 40
  83          ENDIF
  84 C
  85          IF (NIN.LT.0) THEN
  86 C           Division case
  87             JDIV = LQ(JVO-1)
  88             IF (IFIX(Q(JDIV+2)).NE.IVOS) GO TO 40
  89             MULTI = ABS(Q(JDIV+3))
  90             IF (MULTI.EQ.0)  MULTI = 255
  91          ELSE
  92 C           Position case
  93             MULTI = 0
  94             DO 30 IN=1,NIN
  95                JIN = LQ(JVO-IN)
  96                IF (IFIX(Q(JIN+2)).NE.IVOS) GO TO 30
  97                MULTI = MAX(MULTI, IFIX(Q(JIN+3)))
  98    30       CONTINUE
  99             IF (MULTI.EQ.0) GO TO 40
 100          ENDIF
 101 C
 102 C     New level found
 103 C
 104          LIMUL(NLEV) = MULTI
 105          IF (NLEV.EQ.NLVMAX) GO TO 920
 106          IF (NSK(NLEV).EQ.NSKMAX) GO TO 930
 107          NSK(NLEV) = NSK(NLEV) +1
 108          IVOSK(NSK(NLEV),NLEV) = IVO
 109          NLEV = NLEV +1
 110          LINAM(NLEV) = IQ(JVOLUM+IVO)
 111          IVOS = IVO
 112          GO TO 20
 113 C
 114    40 CONTINUE
 115 C
 116 C     No more path found at current level
 117 C
 118       IF (NSK(NLEV).EQ.0) GO TO 910
 119       IF (NSK(NLEV).GT.1.OR.LIMUL(NLEV+1).GT.1) THEN
 120          DO 50 N = 1,NSK(NLEV)
 121             IVO = IVOSK(N,NLEV)
 122             NANEW = IQ(JVOLUM+IVO)
 123             IPJD = JD +10
 124             IF (NV.GT.0) THEN
 125                DO 49 I = 1,NV
 126                   IF (NANEW.EQ.IQ(IPJD+1)) GO TO 50
 127                   IPJD = IPJD +2
 128    49          CONTINUE
 129             ENDIF
 130             IF (NV.EQ.NVMAX) GO TO 940
 131             NV = NV +1
 132             IQ(IPJD+1) = NANEW
 133    50    CONTINUE
 134       ENDIF
 135       GO TO 90
 136 C
 137 C     Store current solution
 138 C
 139    60 NSOL = NSOL +1
 140       LIMUL(NLEV) = 0
 141       IF (LIMUL(1).GT.MULT1) MULT1 = LIMUL(1)
 142 #if defined(CERNLIB_DEBUGG)
 143       IF (IDEBUG.NE.0) THEN
 144          WRITE (CHMAIL, 1002) NSOL, NLEV
 145          CALL GMAIL (0,0)
 146          WRITE (CHMAIL, 1012) (LINAM(I),LIMUL(I),I=1,NLEV)
 147          CALL GMAIL (0,0)
 148  1002    FORMAT (' GGDETV DEBUG : NSOL,NLEV ',2I3)
 149  1012    FORMAT (15(1X,A4,I3))
 150       ENDIF
 151 #endif
 152 C
 153       DO 80 N = NLEV,1,-1
 154          LIST(NLIST+1) = LINAM(N)
 155          LIST(NLIST+2) = LIMUL(N)
 156          IF (N.EQ.NLEV)  LIST(NLIST+2) = NLEV
 157          NLIST = NLIST +2
 158    80 CONTINUE
 159       IF (NLEV.LT.3) GO TO 100
 160       NLEV = NLEV -1
 161 C
 162    90 NSK(NLEV) = 0
 163       NLEV = NLEV -1
 164       IF (NLEV.GT.0) GO TO 10
 165 C
 166   100 IF (MULT1.GT.1) THEN
 167         NV = NV +1
 168         IQ(JD+9+2*NV) = LINAM(1)
 169       ENDIF
 170 C
 171 C     Perform final operations on JD bank
 172 C
 173       NW = 0
 174       IF (NV.EQ.0) GO TO 150
 175 C
 176 C     Compute maximum multiplicities
 177 C
 178       DO 120 N = 1,NLIST,2
 179          IPJD = JD +10
 180          DO 110 I = 1,NV
 181             IF (IQ(IPJD+1).EQ.LIST(N))
 182      +          IQ(IPJD+2)=MAX(IQ(IPJD+2),LIST(N+1))
 183             IPJD = IPJD +2
 184   110    CONTINUE
 185   120 CONTINUE
 186 C
 187       IF (IDEBUG.NE.0) THEN
 188          I2 = 0
 189   125    I1 = I2 + 1
 190          I2 = I1 + 14
 191          IF (I2.GT.NV) I2 = NV
 192          WRITE (CHMAIL, 1003) (IQ(JD+10+I),I=2*I1-1,2*I2)
 193          CALL GMAIL (0, 0)
 194          IF (I2.LT.NV)  GO TO 125
 195  1003    FORMAT (10X,15(1X,A4,I3))
 196       ENDIF
 197 C
 198 C     Compute corresponding bit numbers for packing
 199 C
 200       IPJD = JD +10
 201       K = 32
 202       DO 140 N = 1,NV
 203          NBITS = 0
 204   130    NBITS = NBITS +1
 205          IF (IQ(IPJD+2).GT.2**NBITS-1) GO TO 130
 206          IF (NBITS.GE.32)  NBITS = 0
 207          IQ(IPJD+2) = NBITS
 208          IPJD = IPJD +2
 209          IF (NBITS.EQ.0) THEN
 210             K = 32
 211             NW = NW +1
 212          ELSE
 213             K = K +NBITS
 214             IF (K.LE.32) GO TO 140
 215             K = NBITS
 216             NW = NW +1
 217          ENDIF
 218   140 CONTINUE
 219 C
 220   150 IQ(JD+1) = NW
 221       IQ(JD+2) = NV
 222       IQ(JD+9) = NSOL
 223 C
 224       NDATA = 10 +2*NV +NLIST
 225       ND = IQ(JD-1)
 226       CALL MZPUSH (IXCONS, JD, 0, NDATA-ND, 'I')
 227       CALL UCOPY (LIST, IQ(JD+2*NV+11), NLIST)
 228 #if defined(CERNLIB_DEBUGG)
 229       IF (IDEBUG.NE.0) THEN
 230          ND1=MIN(10,NDATA)
 231          WRITE (CHMAIL, 1004) NDATA,(IQ(JD+I),I=1,ND1)
 232          CALL GMAIL (0,0)
 233          DO 160 II=ND1+1,NDATA,10
 234             ND2=MIN(II+9,NDATA)
 235             WRITE (CHMAIL, 1005) (IQ(JD+I),I=II,ND2)
 236             CALL GMAIL (0,0)
 237  160     CONTINUE
 238  1004    FORMAT (' GGDETV DEBUG : NDATA ',I3,'  JD --> ',10I4)
 239  1005    FORMAT (10(1X,A4,I4))
 240       ENDIF
 241 #endif
 242       GO TO 999
 243 C
 244 C     Current detector IDET is an alias
 245 C
 246   200 CONTINUE
 247       IF (IDEBUG.NE.0) THEN
 248          IHALI = IQ(JS+IALI)
 249          WRITE (CHMAIL, 1006) IHALI
 250          CALL GMAIL (0,0)
 251  1006    FORMAT ('       Alias of detector ',A4)
 252       ENDIF
 253 C
 254       IDM = IQ(JD+10)
 255       JDM = LQ(JS-IDM)
 256       NDM = IQ(JDM-1)
 257       ND = IQ(JD-1)
 258       CALL MZPUSH (IXCONS, JD, 0, NDM-ND, 'I')
 259       NWHI = IQ(JD+7)
 260       NWDI = IQ(JD+8)
 261       JS = LQ(JSET-ISET)
 262       JDM  = LQ(JS-IDM)
 263       CALL UCOPY (IQ(JDM+1), IQ(JD+1), NDM)
 264       IQ(JD+7) = NWHI
 265       IQ(JD+8) = NWDI
 266       IQ(JD+10) = IDM
 267       GO TO 999
 268 C
 269 C     Errors
 270 C
 271   910 WRITE (CHMAIL, 1000) LINAM(NLEV)
 272       CALL GMAIL (0,0)
 273  1000 FORMAT (' GGDETV : Hanging volume ',A4)
 274       GO TO 990
 275   920 CHMAIL=' GGDETV : Parameter NLVMAX too small'
 276       CALL GMAIL (0,0)
 277       GO TO 990
 278   930 CHMAIL=' GGDETV : Parameter NSKMAX too small'
 279       CALL GMAIL (0,0)
 280       GO TO 990
 281   940 CHMAIL=' GGDETV : NVMAX (= size of NUMBV) too small'
 282       CALL GMAIL (0,0)
 283   990 IEOTRI = 1
 284 C
 285   999 RETURN
 286       END