]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gdraw/gdtree.F
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdtree.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:29 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani
11*-- Author :
12 SUBROUTINE GDTREE(KNAME,LEVMAX,ISEL)
13C.
14C. ******************************************************************
15C. * *
16C. * Draw the tree of geometric data structure starting *
17C. * from object KNAME, for LEVMAX depth levels (0=all) *
18C. * *
19C. * If ISEL= 0 then draw only node name; *
20C. * if ISEL=xxxxxx1 then add multiplicity; *
21C. * if ISEL=xxxxx1x then add 'ONLY' information; *
22C. * if ISEL=xxxx1xx then add 'DET ' information; *
23C. * if ISEL=xxx1xxx then add 'SEEN' information; *
24C. * if ISEL=xx1xxxx then add little picture of volume; *
25C. * if ISEL=x1xxxxx then add graphics cursor and *
26C. * returns in IPICK the node picked; *
27C. * *
28C. * For very big trees, the attribute SEEN -3 can be applied *
29C. * to any node in the level that has too many different *
30C. * nodes (each with a different volume name) : the routine *
31C. * GDTREE will draw only the first, the last, and one *
32C. * dummy node in the middle that tells how many nodes *
33C. * does it stand for. *
34C. * *
35C. * ==>Called by : <USER>, <GXINT> *
36C. * Authors : P.Zanarini ; S.Giani ********* *
37C. * *
38C. ******************************************************************
39C.
40#include "geant321/gcunit.inc"
41#include "geant321/gcbank.inc"
42#include "geant321/gcnum.inc"
43#include "geant321/gcdraw.inc"
44#include "geant321/gchil2.inc"
45#include "geant321/gccurs.inc"
46#include "geant321/gcursb.inc"
47*
48 CHARACTER*4 KNAME,NAME,NAME1,MOTH
49 DIMENSION U(4),V(4),UUU(15),VVV(15),SVVX(3),SVVY(3)
50 SAVE SAVTHE,SAVPHI,SAVU0,SAVV0,SAVSCU,SAVSCV,SVGZUA,SVGZVA
51 SAVE SVGZUB,SVGZVB,SVGZUC,SVGZVC
52 COMMON/NPILEV/NPILE
53
54C.
55C. ------------------------------------------------------------------
56C.
57C Is NAME an existing volume ?
58C
59* CALL IGSET('SYNC',1.)
60 IF (MOMO.EQ.' ') THEN
61 CALL UHTOC(IQ(JVOLUM+1),4,NAME,4)
62 MOMO=NAME
63 ENDIF
64 IF (KNAME.EQ.' ') THEN
65 CALL UHTOC(IQ(JVOLUM+1),4,NAME,4)
66 KNAME=NAME
67 ELSE
68 CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IVO)
69 IF (IVO.LE.0) GO TO 180
70 NAME=KNAME
71 ENDIF
72C
73C Build tree structure using view bank 11
74C
75 IVTREE=NKVIEW+1
76 CALL UCTOH (NAME, IROOT, 4, 4)
77 CALL GDTR0 (IVTREE, IROOT, LEVMAX, IER)
78 IF (IER.NE.0) GO TO 170
79C
80 IPICK=0
81C
82 ISEL5=ISEL/100000
83 ISEL5=ISEL5-ISEL5/2*2
84 ISEL4=ISEL/10000
85 ISEL4=ISEL4-ISEL4/2*2
86 ISEL3=ISEL/1000
87 ISEL3=ISEL3-ISEL3/2*2
88 ISEL2=ISEL/100
89 ISEL2=ISEL2-ISEL2/2*2
90 ISEL1=ISEL/10
91 ISEL1=ISEL1-ISEL1/2*2
92 ISEL0=ISEL/1
93 ISEL0=ISEL0-ISEL0/2*2
94C
95C Save GDRAW calling parameters
96C and ZOOM internal parameters
97C
98 IDRAW=0
99 IF (ISEL4.NE.0) THEN
100 IDRAW=1
101 SAVTHE=GTHETA
102 SAVPHI=GPHI
103 SAVU0=GU0
104 SAVV0=GV0
105 SAVSCU=GSCU
106 SAVSCV=GSCV
107 SVGZUA=GZUA
108 SVGZVA=GZVA
109 SVGZUB=GZUB
110 SVGZVB=GZVB
111 SVGZUC=GZUC
112 SVGZVC=GZVC
113 GZUA=1
114 GZVA=1
115 GZUB=0
116 GZVB=0
117 GZUC=0
118 GZVC=0
119 ENDIF
120C
121C Fill arrays Q(JULEV) and Q(JVLEV)
122C
123 DO 10 I=1,NUMND1
124 IQ(JSCA1+I)=0
125 10 CONTINUE
126C
127 MAXV=LEVMAX
128 LEVVER=1
129 LEVHOR=0
130 MLEVV=1
131 CALL GDTR10(1)
132 MLEVH=LEVHOR
133C
134 PLTVER=25.
135 SIZE=PLTVER/(4.*MLEVV)
136*** SIZE=PLTVER/(4.*MLEVV)
137C
138C Compute user coordinates boundaries of tree picture
139C
140 SIZ2=SIZE*2.
141*** SIZ4=SIZE*4.
142 IF(MLEVH.GT.MLEVV)THEN
143 SIZ4=(MLEVH*SIZ2)/MLEVV
144 FACHV=(MLEVH/2.)/MLEVV
145 IF(FACHV.LT.2.)FACHV=1.
146 ELSE
147 SIZ4=SIZE*4.
148 FACHV=1.
149 ENDIF
150 SIZD2=SIZE/2.
151 XPLT=MLEVH*SIZ2
152 YPLT=MLEVV*SIZ4
153C
154C Save current ranges and store new ones
155C
156 SAVPLX=PLTRNX
157 SAVPLY=PLTRNY
158C
159 PLTRNX=YPLT
160 PLTRNY=XPLT
161C
162 CALL IGRNG(YPLT,XPLT)
163* CALL IGRNG(XPLT,YPLT)
164C
165C Draw nodes
166C
167 IDUP=1
168 IONL=1
169 IDET=0
170 ISEEN=1
171* INTSPI=0
172 DO 60 J=1,NUMND1
173 IF (IQ(JSCA1+J).NE.0) THEN
174 CALL UHTOC(IQ(JNAM1+J),4,NAME,4)
175 IF(INTFLA.EQ.10)THEN
176 IADDI=0
177* INTSPI=1
178 INTFLA=1
179 CALL MZLINT(IXDIV,'/GCHIL2/',LARETT,JMYMOT,LARETT)
180 LARETT(1)=1
181 IF(JTICK.NE.0) CALL MZDROP(IXSTOR, JTICK, ' ')
182 IF(JMYLL.NE.0) CALL MZDROP(IXSTOR, JMYLL, ' ')
183 NEE=NUMND1+10
184 NEES=NEE*2
185 CALL MZNEED(IXDIV,NEES,'G')
186 CALL MZBOOK(IXDIV,JTICK,JTICK,1,'TTT',0,0,NEE,2,-1)
187 CALL MZBOOK(IXDIV,JMYLL,JMYLL,1,'MMM',0,0,NEE,2,-1)
188 IF(JFIMOT.NE.0) CALL MZDROP(IXSTOR, JFIMOT, ' ')
189 IF(JFISCA.NE.0) CALL MZDROP(IXSTOR, JFISCA, ' ')
190 IF(JFINAM.NE.0) CALL MZDROP(IXSTOR, JFINAM, ' ')
191 NEES=NEE*3
192 CALL MZNEED(IXDIV,NEES,'G')
193 CALL MZBOOK(IXDIV,JFIMOT,JFIMOT,1,'FIMO',0,0,NEE,2,-1)
194 CALL MZBOOK(IXDIV,JFISCA,JFISCA,1,'FISC',0,0,NEE,2,-1)
195 CALL MZBOOK(IXDIV,JFINAM,JFINAM,1,'FINA',0,0,NEE,2,-1)
196 NUMND2=NUMND1
197 ENDIF
198 IF(INTFLA.EQ.1)THEN
199 MLETMP=MLEVV
200 LEVTMP=LEVVER
201 MLEVV=1
202 LEVVER=1
203 CALL GDTR10(J)
204 IQ(JTICK+J)=MLEVV-1
205 MLEVV=MLETMP
206 LEVVER=LEVTMP
207 IF(J.NE.1)THEN
208* IF(INTSPI.NE.1)THEN
209* NUMNDA=NUMND1
210* NUMND1=NUMNDS
211* DO 89 JI=1,NUMNDS
212* IQ(JNAM1+JI)=IQ(JAASS3+JI)
213* IQ(JSCA1+JI)=IQ(JAASS4+JI)
214* IQ(JMOT1+JI)=IQ(JMYMOT+JI)
215* 89 CONTINUE
216* ENDIF
217 DO 20 LL=1,16
218 CALL GDTR8(NAME,MOTH,IONL)
219 IF(MOTH.EQ.KNAME)THEN
220 IQ(JMYLL+J)=LL+1+IADDI
221 GOTO 30
222 ENDIF
223 NAME=MOTH
224 20 CONTINUE
225 30 CONTINUE
226* IF(INTSPI.NE.1)NUMND1=NUMNDA
227 ELSE
228 IQ(JMYLL+J)=1+IADDI
229 ENDIF
230 ELSE
231 Q(JULEV+J) = (Q(JULEV+J)-1.)*SIZ2 + SIZE
232*** Q(JVLEV+J) = YPLT - (Q(JVLEV+J)-1.)*SIZ4 - SIZ2
233 Q(JVLEV+J) = (Q(JVLEV+J)-1.)*SIZ4 + SIZ2
234 IF (ISEL0.NE.0) IDUP=IQ(JDUP1+J)
235 IF (ISEL1.NE.0) CALL GDTR8(NAME,MOTH,IONL)
236 IF (ISEL2.NE.0) THEN
237 IDET=0
238 KVAL=0
239 CALL GFATT(NAME,'DET ',KVAL)
240 IF (KVAL.GT.0) IDET=1
241 ENDIF
242 IF (ISEL3.NE.0) THEN
243 KVAL=1
244 CALL GFATT(NAME,'SEEN',KVAL)
245 IF (KVAL.EQ.1.OR.KVAL.EQ.-2) THEN
246 ISEEN=1
247 ELSE
248 ISEEN=0
249 ENDIF
250 IF (J.EQ.1) GO TO 50
251 JM=J
252 40 CONTINUE
253 JM=IQ(JMOT1+JM)
254 KVALM=1
255 CALL UHTOC(IQ(JNAM1+JM),4,NAME1,4)
256 CALL GFATT(NAME1,'SEEN',KVALM)
257 IF (KVALM.LT.0) THEN
258 ISEEN=0
259 GO TO 50
260 ENDIF
261 IF (JM.NE.1) GO TO 40
262 50 CONTINUE
263 ENDIF
264***** CALL GDPRTR(NAME,Q(JVLEV+J),Q(JULEV+J),SIZE,IDUP,IDRAW,
265***** + IONL, IDET,ISEEN)
266 NPILE=IQ(JMYLL+J)
267 CALL GDPRTR(NAME,Q(JULEV+J),Q(JVLEV+J),SIZE,FACHV,IDUP,
268 + IDRAW, IONL, IDET,ISEEN)
269 ENDIF
270 ENDIF
271 60 CONTINUE
272C
273C Draw links
274C
275 IF(INTFLA.EQ.1)GOTO 160
276 LINCOL=1
277 CALL MVBITS(LINCOL,0,8,LINATT,16)
278 IF (IQ(JMOT1+1).NE.0) THEN
279 U(2)=Q(JULEV+1)
280 U(1)=U(2)
281 V(2)=Q(JVLEV+1)-(SIZD2*2.*FACHV)
282 V(1)=V(2)-(SIZE*2.*FACHV)
283 CALL GDRAWV(V,U,2)
284*** CALL GDRAWV(U,V,2)
285 ENDIF
286C
287 IGREEN=1
288 DO 150 J=1,NUMND1
289 IF (IQ(JSCA1+J).EQ.1) THEN
290 JX=IQ(JXON1+J)
291 70 IF (JX.EQ.0) GO TO 120
292* U(1)=Q(JULEV+J)
293* U(2)=Q(JULEV+JX)
294* V(1)=Q(JVLEV+J)+(SIZD2*2.*FACHV)
295* V(2)=Q(JVLEV+JX)-(SIZD2*2.*FACHV)
296 U(1)=Q(JULEV+J)
297 U(2)=U(1)
298 U(3)=Q(JULEV+JX)
299 U(4)=Q(JULEV+JX)
300 V(1)=Q(JVLEV+J)+(SIZD2*2.*FACHV)
301 V(4)=Q(JVLEV+JX)-(SIZD2*2.*FACHV)
302 V(2)=(V(1)+V(4))/2.
303 V(3)=V(2)
304 IF(J.EQ.1)HALF=V(4)-V(3)
305 IF(NNPAR.EQ.3)THEN
306 CALL IGPID(1,' ',J,' ')
307 ENDIF
308 CALL GDRAWV(V,U,4)
309***
310 IF(INTFLA.EQ.-1)THEN
311 ARROWS=(SIZD2*2.*FACHV)/10.
312 NPO=IQ(JTICK+J)
313 FRA=(V(2)-V(1))/NPO
314 DO 80 KJI=1,NPO
315 VVV(KJI)=V(1)-(FRA/2.)+(FRA*KJI)
316 UUU(KJI)=U(1)
317 80 CONTINUE
318 CALL ISFACI(2)
319 CALL ISFAIS(1)
320 DO 90 KJI=1,NPO
321 SVVX(1)=VVV(KJI)-ARROWS
322 SVVX(2)=VVV(KJI)-ARROWS
323 SVVX(3)=VVV(KJI)+ARROWS
324 SVVY(1)=UUU(KJI)+ARROWS
325 SVVY(2)=UUU(KJI)-ARROWS
326 SVVY(3)=UUU(KJI)
327 IF(NNPAR.EQ.3)THEN
328 CALL IGPID(1,'Tree',IQ(JNAM1+J),' ')
329 CALL IGPID(2,'Arrow',KJI+1,' ')
330 ENDIF
331 CALL IFA(3,SVVX,SVVY)
332 90 CONTINUE
333*** CALL GDRAWV(U,V,2)
334 NPO=IQ(JMYLL+J)
335 FRA=(V(4)-V(3))/NPO
336 DO 100 KJI=1,NPO
337 VVV(KJI)=V(3)-(FRA/2.)+(FRA*KJI)
338 UUU(KJI)=U(3)
339 100 CONTINUE
340 CALL ISFACI(3)
341 CALL ISFAIS(1)
342 IGREEN=IGREEN+1
343 IORGO=0
344 DO 110 KJI=NPO,1,-1
345 IORGO=IORGO+1
346 SVVX(1)=VVV(KJI)+ARROWS
347 SVVX(2)=VVV(KJI)+ARROWS
348 SVVX(3)=VVV(KJI)-ARROWS
349 SVVY(1)=UUU(KJI)+ARROWS
350 SVVY(2)=UUU(KJI)-ARROWS
351 SVVY(3)=UUU(KJI)
352 IF(NNPAR.EQ.3)THEN
353 CALL IGPID(1,'Tree',IQ(JNAM1+IGREEN),' ')
354 CALL IGPID(2,'Arrow',-IORGO,' ')
355 ENDIF
356 CALL IFA(3,SVVX,SVVY)
357 110 CONTINUE
358 ENDIF
359***
360 JX=IQ(JBRO1+JX)
361 GO TO 70
362 120 CONTINUE
363 ELSE IF (IQ(JSCA1+J).EQ.-1) THEN
364 IF(INTFLA.EQ.-1)THEN
365 ARROWS=(SIZD2*2.*FACHV)/10.
366 U(1)=Q(JULEV+J)
367 U(2)=U(1)
368 V(1)=Q(JVLEV+J)+(SIZD2*2.*FACHV)
369 V(2)=V(1)+(SIZE*2.*FACHV)
370 CALL GDRAWV(V,U,2)
371 NPO=IQ(JTICK+J)
372 FRA=(V(2)-V(1))/(NPO*2.)
373 DO 130 KJI=1,NPO
374 VVV(KJI)=V(1)-(FRA/2.)+(FRA*KJI)
375 UUU(KJI)=U(1)
376 130 CONTINUE
377 CALL ISFACI(2)
378 CALL ISFAIS(1)
379 DO 140 KJI=1,NPO
380 SVVX(1)=VVV(KJI)-ARROWS
381 SVVX(2)=VVV(KJI)-ARROWS
382 SVVX(3)=VVV(KJI)+ARROWS
383 SVVY(1)=UUU(KJI)+ARROWS
384 SVVY(2)=UUU(KJI)-ARROWS
385 SVVY(3)=UUU(KJI)
386 IF(NNPAR.EQ.3)THEN
387 CALL IGPID(1,'Tree',IQ(JNAM1+J),' ')
388 CALL IGPID(2,'Arrow',KJI+1,' ')
389 ENDIF
390 CALL IFA(3,SVVX,SVVY)
391 140 CONTINUE
392*** CALL GDRAWV(U,V,2)
393 ENDIF
394 ENDIF
395 150 CONTINUE
396C
397C Restore GDRAW calling parameters
398C and ZOOM internal parameters
399C
400 160 CONTINUE
401 IF (ISEL4.NE.0) THEN
402 GTHETA=SAVTHE
403 GPHI=SAVPHI
404 GU0=SAVU0
405 GV0=SAVV0
406 GSCU=SAVSCU
407 GSCV=SAVSCV
408 NGVIEW=0
409 GZUA=SVGZUA
410 GZVA=SVGZVA
411 GZUB=SVGZUB
412 GZVB=SVGZVB
413 GZUC=SVGZUC
414 GZVC=SVGZVC
415 ENDIF
416C
417C Restore original ranges previously saved
418C
419 PLTRNX=SAVPLX
420 PLTRNY=SAVPLY
421C
422************ CALL IGRNG(PLTRNX,PLTRNY)
423C
424C Delete tree structure on view bank 11
425C
426 170 CALL GDTR99(IVTREE)
427 GO TO 999
428C
429 180 WRITE(CHMAIL,10000)KNAME
430 CALL GMAIL(0,0)
43110000 FORMAT(' GDTREE: VOLUME ',A4,' DOES NOT EXIST')
432C
433 999 END