Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / ghits / ggdetv.F
CommitLineData
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)
13C.
14C. ******************************************************************
15C. * *
16C. * Routine - to compute and store the list of volumes which *
17C. * permit to identify uniquely any detector volume specified *
18C. * by the set number ISET, the detector number IDET and the *
19C. * corresponding list of volume copy numbers *
20C. * - to compute and store the physical path(s) through *
21C. * the JVOLUM data structure down to the given detector volume *
22C. * *
23C. * ==>Called by : GHCLOS *
24C. * Author F.Bruyant ********* *
25C. * *
26C. ******************************************************************
27C.
28#include "geant321/gcbank.inc"
29#include "geant321/gcflag.inc"
30#include "geant321/gcnum.inc"
31#include "geant321/gcunit.inc"
32C.
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))
39C.
40C. -------------------------------------------------------------
41C.
42 JS = LQ(JSET-ISET)
43 JD = LQ(JS-IDET)
44C
45C Check that JD bank has been created by GSDETV (not GSDET)
46C or has not been already processed.
47C
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
56C
57C Check that current detector is not an alias
58C
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)
70C
71C Search for detector parents up to top of tree
72C
73 20 IF (IVOS.EQ.1) GO TO 60
74C
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
81C Skip mother banks already found
82 IF (IUCOMP (IVO, IVOSK(1,NLEV), NSK(NLEV)) .NE. 0) GO TO 40
83 ENDIF
84C
85 IF (NIN.LT.0) THEN
86C 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
92C 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
101C
102C New level found
103C
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
113C
114 40 CONTINUE
115C
116C No more path found at current level
117C
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
136C
137C Store current solution
138C
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
152C
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
161C
162 90 NSK(NLEV) = 0
163 NLEV = NLEV -1
164 IF (NLEV.GT.0) GO TO 10
165C
166 100 IF (MULT1.GT.1) THEN
167 NV = NV +1
168 IQ(JD+9+2*NV) = LINAM(1)
169 ENDIF
170C
171C Perform final operations on JD bank
172C
173 NW = 0
174 IF (NV.EQ.0) GO TO 150
175C
176C Compute maximum multiplicities
177C
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
186C
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
197C
198C Compute corresponding bit numbers for packing
199C
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
219C
220 150 IQ(JD+1) = NW
221 IQ(JD+2) = NV
222 IQ(JD+9) = NSOL
223C
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
243C
244C Current detector IDET is an alias
245C
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
253C
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
268C
269C Errors
270C
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
284C
285 999 RETURN
286 END