[u/mrichter/AliRoot.git] / GEANT321 / ghits / ggdetv.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:21:10  cernlib
* Geant
*
*
#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
Commit	Line	Data
fe4da5cc	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(2NLVMAX+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=2I1-1,2I2)
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