]>
Commit | Line | Data |
---|---|---|
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) | |
13 | C. | |
14 | C. ****************************************************************** | |
15 | C. * * | |
16 | C. * Draw the tree of geometric data structure starting * | |
17 | C. * from object KNAME, for LEVMAX depth levels (0=all) * | |
18 | C. * * | |
19 | C. * If ISEL= 0 then draw only node name; * | |
20 | C. * if ISEL=xxxxxx1 then add multiplicity; * | |
21 | C. * if ISEL=xxxxx1x then add 'ONLY' information; * | |
22 | C. * if ISEL=xxxx1xx then add 'DET ' information; * | |
23 | C. * if ISEL=xxx1xxx then add 'SEEN' information; * | |
24 | C. * if ISEL=xx1xxxx then add little picture of volume; * | |
25 | C. * if ISEL=x1xxxxx then add graphics cursor and * | |
26 | C. * returns in IPICK the node picked; * | |
27 | C. * * | |
28 | C. * For very big trees, the attribute SEEN -3 can be applied * | |
29 | C. * to any node in the level that has too many different * | |
30 | C. * nodes (each with a different volume name) : the routine * | |
31 | C. * GDTREE will draw only the first, the last, and one * | |
32 | C. * dummy node in the middle that tells how many nodes * | |
33 | C. * does it stand for. * | |
34 | C. * * | |
35 | C. * ==>Called by : <USER>, <GXINT> * | |
36 | C. * Authors : P.Zanarini ; S.Giani ********* * | |
37 | C. * * | |
38 | C. ****************************************************************** | |
39 | C. | |
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 | ||
54 | C. | |
55 | C. ------------------------------------------------------------------ | |
56 | C. | |
57 | C Is NAME an existing volume ? | |
58 | C | |
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 | |
72 | C | |
73 | C Build tree structure using view bank 11 | |
74 | C | |
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 | |
79 | C | |
80 | IPICK=0 | |
81 | C | |
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 | |
94 | C | |
95 | C Save GDRAW calling parameters | |
96 | C and ZOOM internal parameters | |
97 | C | |
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 | |
120 | C | |
121 | C Fill arrays Q(JULEV) and Q(JVLEV) | |
122 | C | |
123 | DO 10 I=1,NUMND1 | |
124 | IQ(JSCA1+I)=0 | |
125 | 10 CONTINUE | |
126 | C | |
127 | MAXV=LEVMAX | |
128 | LEVVER=1 | |
129 | LEVHOR=0 | |
130 | MLEVV=1 | |
131 | CALL GDTR10(1) | |
132 | MLEVH=LEVHOR | |
133 | C | |
134 | PLTVER=25. | |
135 | SIZE=PLTVER/(4.*MLEVV) | |
136 | *** SIZE=PLTVER/(4.*MLEVV) | |
137 | C | |
138 | C Compute user coordinates boundaries of tree picture | |
139 | C | |
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 | |
153 | C | |
154 | C Save current ranges and store new ones | |
155 | C | |
156 | SAVPLX=PLTRNX | |
157 | SAVPLY=PLTRNY | |
158 | C | |
159 | PLTRNX=YPLT | |
160 | PLTRNY=XPLT | |
161 | C | |
162 | CALL IGRNG(YPLT,XPLT) | |
163 | * CALL IGRNG(XPLT,YPLT) | |
164 | C | |
165 | C Draw nodes | |
166 | C | |
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 | |
272 | C | |
273 | C Draw links | |
274 | C | |
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 | |
286 | C | |
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 | |
396 | C | |
397 | C Restore GDRAW calling parameters | |
398 | C and ZOOM internal parameters | |
399 | C | |
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 | |
416 | C | |
417 | C Restore original ranges previously saved | |
418 | C | |
419 | PLTRNX=SAVPLX | |
420 | PLTRNY=SAVPLY | |
421 | C | |
422 | ************ CALL IGRNG(PLTRNX,PLTRNY) | |
423 | C | |
424 | C Delete tree structure on view bank 11 | |
425 | C | |
426 | 170 CALL GDTR99(IVTREE) | |
427 | GO TO 999 | |
428 | C | |
429 | 180 WRITE(CHMAIL,10000)KNAME | |
430 | CALL GMAIL(0,0) | |
431 | 10000 FORMAT(' GDTREE: VOLUME ',A4,' DOES NOT EXIST') | |
432 | C | |
433 | 999 END |