*
* $Id$
*
* $Log$
* Revision 1.1  1995/10/24 10:21:09  cernlib
* Initial revision
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.20  by  S.Giani
*-- Author :
      SUBROUTINE GGDETV (ISET, IDET)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *    Routine - to compute and store the list of volumes which    *
C.    *    permit to identify uniquely any detector volume specified   *
C.    *    by  the set number ISET, the detector number IDET and the   *
C.    *    corresponding list of volume copy numbers                   *
C.    *            - to compute and store the physical path(s) through *
C.    *    the JVOLUM data structure down to the given detector volume *
C.    *                                                                *
C.    *    ==>Called by : GHCLOS                                       *
C.    *         Author  F.Bruyant  *********                           *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcflag.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcunit.inc"
C.
      PARAMETER (NLVMAX=15,NSKMAX=20,NVMAX=20)
      INTEGER  IVOSK(NSKMAX,NLVMAX-1), LIMUL(NLVMAX), LINAM(NLVMAX)
     +,        LIST(2), NSK(NLVMAX-1)
      EQUIVALENCE (LINAM(1),WS(1)), (LIMUL(1),WS(NLVMAX+1)), (IVOSK(1,1)
     +,   WS(2*NLVMAX+1)), (NSK(1),WS((NSKMAX+2)*(NLVMAX-1)+3))
     +,   (LIST(1),WS((NSKMAX+3)*(NLVMAX-1)+3))
C.
C.         -------------------------------------------------------------
C.
      JS = LQ(JSET-ISET)
      JD = LQ(JS-IDET)
C
C     Check that JD bank has been created by GSDETV (not GSDET)
C      or has not been already processed.
C
      IF (IQ(JD+9).NE.-1) GO TO 999
      IQ(JD+9) = -2
      IHDET = IQ(JS+IDET)
      IF (IDEBUG.NE.0) THEN
         WRITE (CHMAIL, 1001) IHDET
         CALL GMAIL (0,0)
 1001    FORMAT (' GGDETV : Detector ',A4)
      ENDIF
C
C     Check that current detector is not an alias
C
      IALI = IQ(JD+10)
      IF (IALI.NE.0) GO TO 200
      NSOL = 0
      NV = 0
 
      NLIST = 0
      CALL VZERO (NSK, NLVMAX-1)
      NLEV = 1
      LINAM(1) = IHDET
      MULT1 = 1
   10 IVOS = IUCOMP (LINAM(NLEV), IQ(JVOLUM+1), NVOLUM)
C
C     Search for detector parents up to top of tree
C
   20 IF (IVOS.EQ.1) GO TO 60
C
      DO 40 IVO=1,NVOLUM
         IF (IVO.EQ.IVOS) GO TO 40
         JVO = LQ(JVOLUM-IVO)
         NIN = Q(JVO+3)
         IF (NIN.EQ.0) GO TO 40
         IF (NSOL.GT.0) THEN
C           Skip mother banks already found
            IF (IUCOMP (IVO, IVOSK(1,NLEV), NSK(NLEV)) .NE. 0) GO TO 40
         ENDIF
C
         IF (NIN.LT.0) THEN
C           Division case
            JDIV = LQ(JVO-1)
            IF (IFIX(Q(JDIV+2)).NE.IVOS) GO TO 40
            MULTI = ABS(Q(JDIV+3))
            IF (MULTI.EQ.0)  MULTI = 255
         ELSE
C           Position case
            MULTI = 0
            DO 30 IN=1,NIN
               JIN = LQ(JVO-IN)
               IF (IFIX(Q(JIN+2)).NE.IVOS) GO TO 30
               MULTI = MAX(MULTI, IFIX(Q(JIN+3)))
   30       CONTINUE
            IF (MULTI.EQ.0) GO TO 40
         ENDIF
C
C     New level found
C
         LIMUL(NLEV) = MULTI
         IF (NLEV.EQ.NLVMAX) GO TO 920
         IF (NSK(NLEV).EQ.NSKMAX) GO TO 930
         NSK(NLEV) = NSK(NLEV) +1
         IVOSK(NSK(NLEV),NLEV) = IVO
         NLEV = NLEV +1
         LINAM(NLEV) = IQ(JVOLUM+IVO)
         IVOS = IVO
         GO TO 20
C
   40 CONTINUE
C
C     No more path found at current level
C
      IF (NSK(NLEV).EQ.0) GO TO 910
      IF (NSK(NLEV).GT.1.OR.LIMUL(NLEV+1).GT.1) THEN
         DO 50 N = 1,NSK(NLEV)
            IVO = IVOSK(N,NLEV)
            NANEW = IQ(JVOLUM+IVO)
            IPJD = JD +10
            IF (NV.GT.0) THEN
               DO 49 I = 1,NV
                  IF (NANEW.EQ.IQ(IPJD+1)) GO TO 50
                  IPJD = IPJD +2
   49          CONTINUE
            ENDIF
            IF (NV.EQ.NVMAX) GO TO 940
            NV = NV +1
            IQ(IPJD+1) = NANEW
   50    CONTINUE
      ENDIF
      GO TO 90
C
C     Store current solution
C
   60 NSOL = NSOL +1
      LIMUL(NLEV) = 0
      IF (LIMUL(1).GT.MULT1) MULT1 = LIMUL(1)
#if defined(CERNLIB_DEBUGG)
      IF (IDEBUG.NE.0) THEN
         WRITE (CHMAIL, 1002) NSOL, NLEV
         CALL GMAIL (0,0)
         WRITE (CHMAIL, 1012) (LINAM(I),LIMUL(I),I=1,NLEV)
         CALL GMAIL (0,0)
 1002    FORMAT (' GGDETV DEBUG : NSOL,NLEV ',2I3)
 1012    FORMAT (15(1X,A4,I3))
      ENDIF
#endif
C
      DO 80 N = NLEV,1,-1
         LIST(NLIST+1) = LINAM(N)
         LIST(NLIST+2) = LIMUL(N)
         IF (N.EQ.NLEV)  LIST(NLIST+2) = NLEV
         NLIST = NLIST +2
   80 CONTINUE
      IF (NLEV.LT.3) GO TO 100
      NLEV = NLEV -1
C
   90 NSK(NLEV) = 0
      NLEV = NLEV -1
      IF (NLEV.GT.0) GO TO 10
C
  100 IF (MULT1.GT.1) THEN
        NV = NV +1
        IQ(JD+9+2*NV) = LINAM(1)
      ENDIF
C
C     Perform final operations on JD bank
C
      NW = 0
      IF (NV.EQ.0) GO TO 150
C
C     Compute maximum multiplicities
C
      DO 120 N = 1,NLIST,2
         IPJD = JD +10
         DO 110 I = 1,NV
            IF (IQ(IPJD+1).EQ.LIST(N))
     +          IQ(IPJD+2)=MAX(IQ(IPJD+2),LIST(N+1))
            IPJD = IPJD +2
  110    CONTINUE
  120 CONTINUE
C
      IF (IDEBUG.NE.0) THEN
         I2 = 0
  125    I1 = I2 + 1
         I2 = I1 + 14
         IF (I2.GT.NV) I2 = NV
         WRITE (CHMAIL, 1003) (IQ(JD+10+I),I=2*I1-1,2*I2)
         CALL GMAIL (0, 0)
         IF (I2.LT.NV)  GO TO 125
 1003    FORMAT (10X,15(1X,A4,I3))
      ENDIF
C
C     Compute corresponding bit numbers for packing
C
      IPJD = JD +10
      K = 32
      DO 140 N = 1,NV
         NBITS = 0
  130    NBITS = NBITS +1
         IF (IQ(IPJD+2).GT.2**NBITS-1) GO TO 130
         IF (NBITS.GE.32)  NBITS = 0
         IQ(IPJD+2) = NBITS
         IPJD = IPJD +2
         IF (NBITS.EQ.0) THEN
            K = 32
            NW = NW +1
         ELSE
            K = K +NBITS
            IF (K.LE.32) GO TO 140
            K = NBITS
            NW = NW +1
         ENDIF
  140 CONTINUE
C
  150 IQ(JD+1) = NW
      IQ(JD+2) = NV
      IQ(JD+9) = NSOL
C
      NDATA = 10 +2*NV +NLIST
      ND = IQ(JD-1)
      CALL MZPUSH (IXCONS, JD, 0, NDATA-ND, 'I')
      CALL UCOPY (LIST, IQ(JD+2*NV+11), NLIST)
#if defined(CERNLIB_DEBUGG)
      IF (IDEBUG.NE.0) THEN
         ND1=MIN(10,NDATA)
         WRITE (CHMAIL, 1004) NDATA,(IQ(JD+I),I=1,ND1)
         CALL GMAIL (0,0)
         DO 160 II=ND1+1,NDATA,10
            ND2=MIN(II+9,NDATA)
            WRITE (CHMAIL, 1005) (IQ(JD+I),I=II,ND2)
            CALL GMAIL (0,0)
 160     CONTINUE
 1004    FORMAT (' GGDETV DEBUG : NDATA ',I3,'  JD --> ',10I4)
 1005    FORMAT (10(1X,A4,I4))
      ENDIF
#endif
      GO TO 999
C
C     Current detector IDET is an alias
C
  200 CONTINUE
      IF (IDEBUG.NE.0) THEN
         IHALI = IQ(JS+IALI)
         WRITE (CHMAIL, 1006) IHALI
         CALL GMAIL (0,0)
 1006    FORMAT ('       Alias of detector ',A4)
      ENDIF
C
      IDM = IQ(JD+10)
      JDM = LQ(JS-IDM)
      NDM = IQ(JDM-1)
      ND = IQ(JD-1)
      CALL MZPUSH (IXCONS, JD, 0, NDM-ND, 'I')
      NWHI = IQ(JD+7)
      NWDI = IQ(JD+8)
      JS = LQ(JSET-ISET)
      JDM  = LQ(JS-IDM)
      CALL UCOPY (IQ(JDM+1), IQ(JD+1), NDM)
      IQ(JD+7) = NWHI
      IQ(JD+8) = NWDI
      IQ(JD+10) = IDM
      GO TO 999
C
C     Errors
C
  910 WRITE (CHMAIL, 1000) LINAM(NLEV)
      CALL GMAIL (0,0)
 1000 FORMAT (' GGDETV : Hanging volume ',A4)
      GO TO 990
  920 CHMAIL=' GGDETV : Parameter NLVMAX too small'
      CALL GMAIL (0,0)
      GO TO 990
  930 CHMAIL=' GGDETV : Parameter NSKMAX too small'
      CALL GMAIL (0,0)
      GO TO 990
  940 CHMAIL=' GGDETV : NVMAX (= size of NUMBV) too small'
      CALL GMAIL (0,0)
  990 IEOTRI = 1
C
  999 RETURN
      END
