]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gdraw/gdraw.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix needed on Sun and Alpha
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdraw.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:24 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.26 by S.Giani
11*-- Author :
12 SUBROUTINE GDRAW(NAME,UTHET,UPHI,UPSI,UU0,UV0,SU,SV)
13C.
14C. ******************************************************************
15C. * *
16C. * This routine draws the object called NAME, with its *
17C. * contents, at the screen point (UU0,UV0), with the *
18C. * screen factors SU and SV acting on the U and V *
19C. * dimensions respectively; *
20C. * the object is rotated by an angle UTHET along Y-axis *
21C. * and UPHI along Z-axis and the resulting 2-D picture *
22C. * is also rotated by an angle UPSI along the line of *
23C. * projection (i.e. the normal to the 2-D view plane). *
24C. * *
25C. * If IDRNUM<>0 then /GCVOLU/ is already filled by GLVOLU *
26C. * and a special case is handled (GDRAW called by GDRVOL). *
27C. * *
28C. * ==>Called by : <USER>, <GXINT>, GDPRTR, GDRAWC, GDRAWX, *
29C. * GDSPEC *
30C. * Authors : R.Brun, A.McPherson, P.Zanarini, ********* *
31C. * J.Salt, S.Giani *
32C. ******************************************************************
33C.
34***SG**************************************************************************
35* *
36* Most important improvements in this new version : *
37* *
38* Problems with the number of faces are solved, so that it's *
39* possible to use all the memory available; moreover it's *
40* now possible to use HIDE ON on CRAY-like machines; *
41* *
42* Problems with number of volumes now only depends upon the *
43* size of Zebra store : a message will tell the number of *
44* words you need more; problems in iterated drawings have *
45* been solved too. *
46* *
47* A NEW SIZE EVALUATION is performed separately for Hide Structure and *
48* Wire Structure with a resolution of 1 word ; this is the new logic: *
49* create immediately HIDE and WIRE structures and perform the *
50* drawing WHILE evaluating the memory used; if memory booked in the *
51* zebra store is not enough, then go on evaluating the number of *
52* words needed and print it. *
53* *
54* Multi-colour view of the different parts of a detector is now *
55* available in Hidden Line Removal; a new bank is created for this. *
56* Enjoy clipping now !! *
57* Different line styles and width work as well !! *
58* *
59* Zooming is now possible in Hidden Line Removal too; Dspec works *
60* even when Cvol is on and Seen attribute setting has been *
61* optimized. *
62* *
63* Speed in drawing divided volumes can be increased by a factor about *
64* linear with the number of volumes (a factor 30 for 900 tubes)!!! *
65* At the same time, the number of words used can be decreased by a *
66* factor 50!!! For example, in Gexam1 is possible to draw 22500 tubes *
67* using much less than 800000 words. *
68* *
69* HIDDEN FACE REMOVAL algorithm has been implemented; it allows to *
70* increase speed and decrease memory used by the same factors as *
71* above for any kind of drawings!!! For example, it's now possible *
72* to draw the complete L3 geometry using less than 3 Mwords (before *
73* we needed 1 Gigabyte !!!) *
74* *
75* The new command CVOL has been created: it allows to clip EACH *
76* VOLUME in the detector by a different SHAPE; moreover, it's possible*
77* to clip twice each volume. You can clip each volume by the following*
78* shapes: BOX , TUBE, CONE, SPHE ! *
79* *
80* The new command SHIFT has been created: it allows to translate each *
81* volume in the detector into a more visible place; for each volume, *
82* the last shift you asked is performed. *
83* *
84* The option 'one' has been implemented in the shift command to allow *
85* the shifting of a single copy for each volume; the new command *
86* BOMB has been created to allow 'exploded' view of detectors. *
87* *
88* A new bank is booked to create CG objects: it's now possible to draw *
89* in HIDE ON the following shapes as well: PCON, TUBS, SPHE, TRAP *
90* and Pyramids as TRAP having 4 edges in the same point. Moreover, *
91* the new shape CTUB has been created even in hide on. *
92* *
93* The number of words to draw TUBS, CONS, PCON, PGON can be decreased *
94* even by a factor 10; moreover, several problems about edge visi- *
95* bility have been solved. *
96* *
97* A REFLECTION algorithm has been implemented for hidden line removal *
98* as well; finally, a new logic scanning the geometrical tree has *
99* been created to simulate, without alterate, the date structure. *
100* *
101* A new SURFACE SHADING algorithm has been written to fill faces with *
102* solid colours with varying intensity according to the light *
103* inclination. Please see details in the documentation of the *
104* routines which are concerned. *
105* *
106***SG**************************************************************************
107*
108#include "geant321/gcbank.inc"
109#include "geant321/gcvolu.inc"
110#include "geant321/gcunit.inc"
111#include "geant321/gcdraw.inc"
112#include "geant321/gconst.inc"
113#include "geant321/gcnum.inc"
114#include "geant321/gcmutr.inc"
115#include "geant321/gcgobj.inc"
116#if defined(CERNLIB_CG)
117#include "geant321/cghpar.inc"
118#endif
119#include "geant321/gchiln.inc"
120#include "geant321/gcspee.inc"
121*
122* - The following common to be used by GXPICK
123*
124 COMMON /QUEST/ IQUEST(100)
125 COMMON/GCVHLP/NVLAST
126 COMMON/SP3D/ISPFLA
127 COMMON/INIFIR/NFIRST
128*
129 CHARACTER*4 NAME,NAMEE2
130 DIMENSION X(3),ATT(10)
131 DIMENSION LVOLS(15),LINDX(15),LNAMES(15)
132 DIMENSION GPAR(50,15)
133#if defined(CERNLIB_CG)
134 DIMENSION V(3),T(4,3)
135#endif
136 SAVE IFIRST, LFIRST
137 DATA IFIRST,LFIRST/2*0/
138* Save info for GXPICK in case is needed
139 CALL UCTOH(NAME, NVLAST, 4, 4)
140*** CALL IGSET('SYNC',1.)
141*
142* Hidden flag 'ON" (Default)
143*
144 CALL UCTOH('ON ',IFLH,4,4)
145*
146***SG
147*
148 IF(NFIRST.EQ.0)THEN
149 CALL GDCOTA
150 NFIRST=1
151 ENDIF
152#if defined(CERNLIB_CG)
153 IF(IHIDEN.EQ.IFLH)THEN
154 IF(LFIRST.EQ.0) THEN
155* Link area for the banks
156 CALL MZLINT(IXSTOR,'/GCHILN/',LARECG,ICLIP1,ICLIP2)
157 LFIRST = 1
158 ELSE
159 IF(JCGCOL.NE.0) CALL MZDROP(IXSTOR, JCGCOL, ' ')
160 IF(JCGOBJ.NE.0) CALL MZDROP(IXSTOR, JCGOBJ, ' ')
161 IF(JCOUNT.NE.0) CALL MZDROP(IXSTOR, JCOUNT, ' ')
162 IF(JCLIPS.NE.0) CALL MZDROP(IXSTOR, JCLIPS, ' ')
163 IF(IMPOIN.NE.0) CALL MZDROP(IXSTOR, IMPOIN, ' ')
164 IF(IMCOUN.NE.0) CALL MZDROP(IXSTOR, IMCOUN, ' ')
165 IF(JSIX.NE.0) CALL MZDROP(IXSTOR, JSIX, ' ')
166 IF(JSIY.NE.0) CALL MZDROP(IXSTOR, JSIY, ' ')
167 IF(JSIZ.NE.0) CALL MZDROP(IXSTOR, JSIZ, ' ')
168 IF(JPXC.NE.0) CALL MZDROP(IXSTOR, JPXC, ' ')
169 IF(JPYC.NE.0) CALL MZDROP(IXSTOR, JPYC, ' ')
170 IF(JPZC.NE.0) CALL MZDROP(IXSTOR, JPZC, ' ')
171 ENDIF
172 LARECG(1)=1
173*
174* Initialization
175*
176* NWHS1: n. of words for Hide Structure
177* NWWS1: n. of words for Wire Structure
178* NWFLAG: Indicates if the size of CG bank is precise
179* =0 , it is
180* =-9, it isn't
181* IPAS: This flag indicates if the Size Evaluation has been performed
182* =0 , it does not
183* =1 , it does
184* NOBJ: Counter of CG objects
185* NUVO: Counter of CG volumes
186* II: Counter for volumes' line attributes
187* KGG: Flag for booking line attributes bank
188* LSTEP: Number of CG objects forming each volume
189* IFACST: Flag indicating final status of Hide Structure
190* =0 , it's ok
191* <0 , internal error
192* >0 , total number of words needed for Hide Structure
193* NCLAS2: Total number of volumes
194* S1...SS3: Min and Max values of volume scope
195* SRAGMX,SRAGMN: Max values of volume scope along R
196* NFILT= n. of words for HIDE+totalWIRE structures+CG+Line
197* NTCUR= n. of words for HIDE+instantWIRE structures+CG+Line
198* KSTART: Flag for Hidden Volume Removal
199* IOLDOL: Nlevel of last volume setting bounds for scope
200*
201* NWHS1=0
202* NWWS1=0
203* NWFLAG=0
204 IPER=0
205 IPEOLD=0
206 NOBJ=0
207 NUVO=0
208 IPAS=0
209 II=0
210 KGG=0
211 LSTEP=1
212 IFACST=0
213* IWORK=0
214 NCLAS1=0
215 NCLAS2=0
216 NCLAS3=0
217 IIIIII=0
218* Initialization of Hidden Volume and Face Removal
219 S1=0
220 S2=0
221 S3=0
222 SS1=0
223 SS2=0
224 SS3=0
225 SRAGMX=0
226 SRAGMN=0
227 RAINT1=0
228 RAINT2=0
229 ISCOP=0
230 KSTART=0
231 IOLDOL=0
232* Initialisation for Shift
233 NIET=0
234 IOLDSU=0
235 PORGX=0
236 PORGY=0
237 PORGZ=0
238 DO 10 J=1,15
239 POX(J)=0
240 POY(J)=0
241 POZ(J)=0
242 10 CONTINUE
243 DO 20 J=1,100
244 IVECVO(J)=0
245 20 CONTINUE
246 IVOOLD=0
247* IMENO=0
248 IPRELE=0
249* Resetting
250 IHPOIN=0
251 IWPOIN=0
252 ICLIP1=0
253 ICLIP2=0
254 IVOLNA=0
255 LPASS=0
256 NWHS=0
257 MFLA=0
258 MVENLE=0
259 MVECOL=0
260 LFLA=0
261 LVENLE=0
262 LVEWID=0
263 LFFLA=0
264 LFENLE=0
265 LVEFIL=0
266 IXCG=IXSTOR+1
267 JMEMT1=0
268 JMEMT3=0
269 JMEMT2=0
270* Resetting
271 IF(JCG.NE.0)THEN
272 CALL MZDROP(IXSTOR, JCG, ' ')
273 CALL MZGARB(IXSTOR+1,0)
274 ENDIF
275* Booking bank to create CG objects
276 CALL MZNEED(IXCG,30000,'G')
277 CALL MZBOOK(IXCG,JCGOBJ,JCGOBJ,1,'CGOB',0,0,30000,3,-1)
278 CALL MZNEED(IXCG,33000,'G')
279 CALL MZBOOK(IXCG,JCLIPS,JCLIPS,1,'CGCLIP',0,0,33000,3,-1)
280 ICLIP1=JCLIPS+1
281 ICLIP2=JCLIPS+16500
282 JMEMT1=IQUEST(11)*.013
283 IF(JMEMT1.LT.10000)JMEMT1=10000
284 CALL MZNEED(IXCG,JMEMT1,'G')
285 CALL MZBOOK(IXCG,JCOUNT,JCOUNT,1,'CGCONT',0,0,JMEMT1,2,-1)
286 IQ(JCOUNT+1)=1
287 IQ(JCOUNT+2)=4000
288 IQ(JCOUNT+3)=8000
289 LLEP=ABS(LEP)
290 IF(LLEP.NE.1)THEN
291 CALL MZNEED(IXCG,54000,'G')
292 CALL MZBOOK(IXCG,JSIX,JSIX,1,'XGEN',0,0,9000,3,-1)
293 CALL MZBOOK(IXCG,JSIY,JSIY,1,'YGEN',0,0,9000,3,-1)
294 CALL MZBOOK(IXCG,JSIZ,JSIZ,1,'ZGEN',0,0,9000,3,-1)
295 CALL MZBOOK(IXCG,JPXC,JPXC,1,'XPAR',0,0,9000,3,-1)
296 CALL MZBOOK(IXCG,JPYC,JPYC,1,'YPAR',0,0,9000,3,-1)
297 CALL MZBOOK(IXCG,JPZC,JPZC,1,'ZPAR',0,0,9000,3,-1)
298 JMEMT3=JMEMT1
299 CALL MZNEED(IXCG,JMEMT3,'G')
300 CALL MZBOOK(IXCG,IMCOUN,IMCOUN,1,'SHCONT',0,0,JMEMT3,2,-1)
301 IQ(IMCOUN+1)=1
302 IQ(IMCOUN+2)=4000
303 IQ(IMCOUN+3)=8000
304 JMEMT2=IQUEST(11)*.1
305 CALL MZNEED(IXCG,JMEMT2,'G')
306 CALL MZBOOK(IXCG,IMPOIN,IMPOIN,1,'SHAFAC',0,0,JMEMT2,2,-1)
307 ENDIF
308* Resetting
309 CALL GDCGRS
310 NFILT=0
311 NTCUR=0
312 NTNEX=0
313 NAIN=0
314 ITSTCU=0
315 ENDIF
316#endif
317*
318***SG
319C
320C Set IOBJ to VOLUME
321C
322 IOBJ=1
323C
324 IF (IFIRST.NE.0) GO TO 40
325C
326 IFIRST=1
327 DPHI=PI/20.
328 PHI=0.
329C
330 DO 30 I=1,40
331 GSIN(I)=SIN(PHI)
332 GCOS(I)=COS(PHI)
333 PHI=PHI+DPHI
334 30 CONTINUE
335C
336 GSIN(41)=GSIN(1)
337 GCOS(41)=GCOS(1)
338C
339 40 CONTINUE
340C
341C Save /GCVOLU/ if necessary
342C
343 IFCVOL=0
344 IF (NLEVEL.NE.0) THEN
345 CALL GSCVOL
346 IFCVOL=1
347 ENDIF
348 IF (NLEVEL.LT.0) NLEVEL=IABS(NLEVEL)
349C
350C If in cut-mode then open the GDRAWV line buffer
351C else reset ICUT that could have been set by GDRAWC/GDRAWX
352C
353 IF (ICUTFL.EQ.1) THEN
354 CALL GDRAWV(0.,0.,-1)
355 ELSE
356 ICUT=0
357 ENDIF
358C
359C Start of general code
360C
361 CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
362 IF(IVO.LE.0)GO TO 280
363C
364C Theta, phi and psi angles are normalized in [0-360[ range
365C
366
367 GTHETA=MOD(ABS(UTHET),360.)
368 GPHI=MOD(ABS(UPHI),360.)
369 GPSI=MOD(ABS(UPSI),360.)
370 GU0=UU0
371 GV0=UV0
372 GSCU=SU
373 GSCV=SV
374 IMOD=0
375*
376#if defined(CERNLIB_CG)
377* Set Transformation Matrix T for CG Package
378*
379 IF(IHIDEN.EQ.IFLH)THEN
380 V(1)=GTHETA
381 V(2)=GPHI
382 V(3)=GPSI
383 CALL GDCGVW(V,T)
384 CALL CGTSET(NTRCG,T,IREP)
385 IF(IREP.EQ.-1)THEN
386 WRITE(CHMAIL,10200)
387 CALL GMAIL(0,0)
388 ENDIF
389 IF(IREP.EQ.-2)THEN
390 WRITE(CHMAIL,10300)
391 CALL GMAIL(0,0)
392 ENDIF
393*
394* Obtaining the IMOD flag for setting the run mode
395*
396 IF(IPAS.EQ.0)THEN
397 IMOD=0
398 IF(ICUT.NE.0)IMOD=1
399 IF(IHOLE.EQ.1)IMOD=2
400 ELSE
401 IMOD=3
402 IF(ICUT.NE.0)IMOD=4
403 IF(IHOLE.EQ.1)IMOD=5
404 IF(ICUT.NE.0.OR.IHOLE.EQ.1)THEN
405 IFCG=4
406 ILCG=3
407 ENDIF
408 ENDIF
409 ENDIF
410#endif
411*JS
412* 77 CONTINUE
413 SINPSI=SIN(GPSI*DEGRAD)
414 COSPSI=COS(GPSI*DEGRAD)
415 GU0=UU0
416 GV0=UV0
417 NGVIEW=0
418 JVO=LQ(JVOLUM-IVO)
419C
420C Initialize JIN to switch correctly CALL GFPARA/GFIPAR
421C
422 JIN=0
423C
424 LEVSEE=1000
425C
426 IF (IDRNUM.NE.0) GO TO 70
427C
428C Initialize for new geometry structure
429C
430 IF (JGPAR.EQ.0) CALL GMEDIN
431 CALL GLMOTH(NAME,1,NLEV,LVOLS,LINDX)
432 DO 50 J=1, NLEV
433 LNAMES(J)=IQ(JVOLUM+LVOLS(J))
434 50 CONTINUE
435 NLEV=NLEV+1
436 CALL UCTOH(NAME,LNAMES(NLEV),4,4)
437 LINDX(NLEV)=1
438 DO 60 KLEV=2,NLEV
439 JVOF = LQ(JVOLUM-LVOLS(KLEV-1))
440 NIN = Q(JVOF+3)
441 IF(NIN.GT.0) THEN
442 JIN = LQ(JVOF-LINDX(KLEV))
443 ICOPY = Q(JIN+3)
444 ELSE
445 ICOPY = 1
446 ENDIF
447 LINDX(KLEV) = ICOPY
448 60 CONTINUE
449 CALL GLVOLU(NLEV, LNAMES, LINDX, IER)
450C
451 NLVTOP=NLEVEL
452C
453 70 CONTINUE
454C
455 NLMIN=NLEVEL
456 NLMAX=NLEVEL
457C
458 IF (IDRNUM.NE.0) GO TO 110
459C
460 CALL GFPARA(NAME,1,1,NPAR,NATT,GPAR(1,NLEVEL),ATT)
461C
462 IF (NPAR.LE.0) GO TO 290
463C
464 DO 100 LLL=1,NLEVEL
465 DO 90 I=1,3
466 GTRAN(I,LLL)=0.0
467 X(I)=0.0
468 DO 80 J=1,3
469 K=(I-1)*3+J
470 GRMAT(K,LLL)=0.0
471 80 CONTINUE
472 K=I*4-3
473 GRMAT(K,LLL)=1.0
474 90 CONTINUE
475 GRMAT(10,LLL)=0.0
476 100 CONTINUE
477C
478C Ready for general case code
479C
480 110 CONTINUE
481*SG
482* Taking volume name and shape from Zebra Structure
483*
484 IMENO=IVOLNA
485 IVOLNA=IQ(JVOLUM+IVO)
486 ISHAPE=Q(JVO+2)
487*SG
488 GSCU=SU
489 GSCV=SV
490C
491 IF (IDRNUM.NE.0) GO TO 120
492C
493 IF (NLEVEL.EQ.NLVTOP) GO TO 130
494C
495 120 CONTINUE
496C
497 IF (IDRNUM.NE.0.AND.JIN.EQ.0) THEN
498 CALL UHTOC(NAMES(NLEVEL),4,NAMEE2,4)
499 CALL GFPARA(NAMEE2,NUMBER(NLEVEL),1,NPAR,
500 + NATT,GPAR(1,NLEVEL),ATT)
501 ELSE
502 NPAR=Q(JVO+5)
503 NATT=Q(JVO+6)
504 JATT=JVO+7+NPAR
505 CALL UCOPY(Q(JATT),ATT,NATT)
506 ENDIF
507C
508 130 CONTINUE
509C
510 WORK=ATT(1)
511 SEEN=ATT(2)
512*
513 LINSTY=ATT(3)
514 LINWID=ATT(4)
515 LINCOL=ATT(5)
516 LINFIL=ATT(6)
517 IF(LLEP.EQ.1)LINFIL=0
518*SG
519* New logic setting the line attributes
520*
521 IF(NLEVEL.EQ.1)THEN
522*** CALL GDCOTA
523 IF(LINFIL.LT.0)THEN
524 LINFIL=ABS(LINFIL)
525 CALL ISFACI(LINFIL)
526 CALL ISFAIS(1)
527 CALL IGBOX(0.,20.,20.,0.)
528 CALL ISFAIS(0)
529 LINFIL=2
530 ENDIF
531 ENDIF
532 IF(LINCOL.LT.2)THEN
533 IF(MFLA.EQ.1.AND.NLEVEL.GT.MVENLE)LINCOL=MVECOL
534 IF(NLEVEL.LE.MVENLE)MFLA=0
535 IF(LINCOL.LT.0)THEN
536 MVECOL=ABS(LINCOL)
537 LINCOL=MVECOL
538 MVENLE=NLEVEL
539 MFLA=1
540 ENDIF
541 ENDIF
542 IF(LINWID.LT.2)THEN
543 IF(LFLA.EQ.1.AND.NLEVEL.GT.LVENLE)LINWID=LVEWID
544 IF(NLEVEL.LE.LVENLE)LFLA=0
545 IF(LINWID.LT.0)THEN
546 LVEWID=ABS(LINWID)
547 LINWID=LVEWID
548 LVENLE=NLEVEL
549 LFLA=1
550 ENDIF
551 ENDIF
552 IF(LINFIL.LT.1)THEN
553 IF(LFFLA.EQ.1.AND.NLEVEL.GT.LFENLE)LINFIL=LVEFIL
554 IF(NLEVEL.LE.LFENLE)LFFLA=0
555 IF(LINFIL.LT.0)THEN
556 LVEFIL=ABS(LINFIL)
557 LINFIL=LVEFIL
558 LFENLE=NLEVEL
559 LFFLA=1
560 ENDIF
561 ENDIF
562*SG
563 CALL MVBITS(LINCOL,0,8,LINATT,16)
564 CALL MVBITS(LINWID,0,3,LINATT,7)
565 CALL MVBITS(LINSTY,0,3,LINATT,10)
566 CALL MVBITS(LINFIL,0,3,LINATT,13)
567*
568***SG
569*
570* New logic scanning the geometrical tree:
571* A volume can set bounds OR be compared with bounds;
572* this can happen only IF a relationship mother-daughters exists.
573*
574* Optimization for Hidden Volume and Face Removal:
575* POS and DIV cases are considered at the same time.
576*
577 IF(IPAS.EQ.0)GOTO 170
578 IPORLI=0
579 ISUBLI=0
580 IF(KSTART.EQ.1)THEN
581*
582 IF(NLEVEL.GT.IOLDOL)THEN
583 IF(LPASS.EQ.0)THEN
584 ISUBLI=1
585 ELSE
586 IPORLI=1
587 S1=0
588 S2=0
589 S3=0
590 SS1=0
591 SS2=0
592 SS3=0
593 SRAGMX=0
594 SRAGMN=0
595 RAINT1=0
596 RAINT2=0
597 ISCOP=0
598 LPASS=0
599 IF(SEEN.EQ.0.OR.SEEN.EQ.-1)LPASS=1
600 IOLDOL=NLEVEL
601 ENDIF
602*
603 ELSE IF(NLEVEL.LE.IOLDOL)THEN
604 IPORLI=1
605 S1=0
606 S2=0
607 S3=0
608 SS1=0
609 SS2=0
610 SS3=0
611 SRAGMX=0
612 SRAGMN=0
613 RAINT1=0
614 RAINT2=0
615 ISCOP=0
616 LPASS=0
617 IF(SEEN.EQ.0.OR.SEEN.EQ.-1)LPASS=1
618 IOLDOL=NLEVEL
619 ENDIF
620*
621 IF(NLEVEL.LE.IPRELE)THEN
622 IF(IVOLNA.NE.IMENO)THEN
623 NIET=2
624 IF(SEEN.EQ.0.OR.IPORLI.EQ.1.OR.SEEN.EQ.-1)THEN
625 DO 140 I=1,15
626 IF((NLEVEL-I).GE.1)THEN
627 IF(POX(NLEVEL-I).NE.0.OR.POY(NLEVEL-I)
628 + .NE.0.OR. POZ(NLEVEL-I).NE.0)THEN
629 PO1=POX(NLEVEL-I)
630 PO2=POY(NLEVEL-I)
631 PO3=POZ(NLEVEL-I)
632 GOTO 150
633 ENDIF
634 ENDIF
635 140 CONTINUE
636 POX(NLEVEL)=0.
637 POY(NLEVEL)=0.
638 POZ(NLEVEL)=0.
639 PORGX=0.
640 PORGY=0.
641 PORGZ=0.
642 GOTO 160
643 150 CONTINUE
644 POX(NLEVEL)=PO1
645 POY(NLEVEL)=PO2
646 POZ(NLEVEL)=PO3
647 ENDIF
648 160 CONTINUE
649 ENDIF
650 ENDIF
651 IPRELE=NLEVEL
652 ENDIF
653*
654 IF(IOLDOL.EQ.0.AND.(SEEN.EQ.1.OR.SEEN.EQ.-2
655 + .OR.SEEN.EQ.9))THEN
656 KSTART=1
657 IPORLI=1
658 LPASS=0
659 IOLDOL=NLEVEL
660 IPRELE=NLEVEL
661 ENDIF
662 170 CONTINUE
663*
664***SG
665*
666C
667C WORK attribute enabled ?
668C
669 IF(WORK.LE.0.)GO TO 270
670C
671C SEEN attribute processing
672C
673 IF (SEEN.LT.50.) GO TO 180
674 ISEENL=SEEN/10.+0.5
675 SEEN=ISEENL-10
676 180 CONTINUE
677 IF(NLEVEL.LE.LEVSEE)LEVSEE=1000
678 IF(SEEN.EQ.-1.)GO TO 270
679 IF (NLEVEL.GT.LEVSEE) GO TO 270
680 IF(SEEN.EQ.0.)GO TO 220
681 IF (SEEN.EQ.-2.) LEVSEE=NLEVEL
682*JS
683*
684* Logic has been modified >>>>>
685*
686C
687C For the Standard Mode: Draw the shape
688C For CG Mode : Make a CG-Object for each shape
689C
690 IF(IHIDEN.EQ.IFLH)THEN
691*
692* CG Mode:
693*
694*
695* Case : divided without clipping
696*
697****SG
698* Optimization for setting seen attributes
699*
700 NIN=Q(JVO+3)
701 IF(SEEN.EQ.9.AND.NIN.NE.0)THEN
702 LPASS=1
703 ITSTCU=0
704 ICGP=0
705 IIIIII=1
706 GOTO 190
707 ELSE
708 IIIIII=0
709 ENDIF
710 IF(NIN.LT.0.AND.((ISHAPE.GT.1.AND.ISHAPE.LT.5).OR.
711 + (ISHAPE.GT.9.AND.ISHAPE.LT.13)))THEN
712 IF(IPORLI.EQ.1)ISCOP=1
713 ENDIF
714 IF(SEEN.EQ.1.AND.NIN.LT.0)GOTO 190
715 IF(SEEN.NE.-2.AND.NIN.LT.0.AND.(IMOD.EQ.0.OR.IMOD.EQ.3))
716 + GOTO 240
717 190 CONTINUE
718*
719#if defined(CERNLIB_CG)
720*
721* Creating, clipping and counting CG objects
722* Inserting the visible ones in Hide and Wire Structures
723*
724 IF(IIIIII.EQ.1)GOTO 200
725 IMSE=IMOD
726 IF(ISHAPE.EQ.11)LSTEP=GPAR(4,NLEVEL)-1
727 IF(ISHAPE.EQ.12)LSTEP=GPAR(3,NLEVEL)-1
728 CALL GDCGOB(IMSE,ISHAPE,GPAR(1,NLEVEL),NOBJ,NWWS,IVOLNA,
729 +LSTEP)
730 200 CONTINUE
731 NOBJ=NOBJ+LSTEP
732 NUVO=NUVO+1
733 LSTEP=1
734 IF(IPAS.NE.0)THEN
735 IF(NCLAS2.GT.1000)THEN
736 IPER=(100*NOBJ)/NCLAS2
737 IF(IPER.EQ.10.OR.IPER.EQ.20.OR.IPER.EQ.30.OR.IPER.EQ.
738 + 40.OR.IPER.EQ.50.OR.IPER.EQ.60.OR.IPER.EQ.70.OR.IPER
739 + .EQ.80.OR.IPER.EQ.90)THEN
740 IF(IPER.NE.IPEOLD)THEN
741 WRITE(CHMAIL,11800)IPER
742 CALL GMAIL(0,0)
743 IPEOLD=IPER
744 ENDIF
745 ENDIF
746 ENDIF
747 ENDIF
748*
749* Setting line attributes volume by volume
750*
751 IF(IHIDEN.EQ.IFLH) THEN
752 IF(IPAS.NE.0.AND.KGG.EQ.1) THEN
753** IF(ITSTCU.NE.0.AND.IVFUN.NE.0) THEN
754 IF((ITSTCU.NE.0).OR. ((ISHAPE.EQ.11.OR.ISHAPE.EQ.12)
755 + .AND.(ICGP.NE.0)))THEN
756 IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)LSTEP=ICGP
757 LL=II+1
758 II=II+LSTEP
759 DO 210 KHH=LL,II
760 IQ(JCGCOL+KHH)=LINATT
761 210 CONTINUE
762 LSTEP=1
763 ENDIF
764 ENDIF
765 ENDIF
766*
767*
768* Logic has been modified again :
769* do the size evaluation while creating Hide Structure
770* do the same for Wire Structure
771*
772* If number of words booked for Hide Structure or for
773* Wire Structure is not sufficient, then evaluate the
774* the right number of words needed and send a mail.
775*
776 IF(KCGST.EQ.-9)THEN
777*
778* Ten words more for safety
779*
780 NWHS1 = NCLAS1+ 10
781 CALL CGHEVA(Q(IHPOIN),HISI)
782 IF(HISI.GT.NWHS1)NWHS1=HISI
783 IWORH = NWHS1 - NWHS
784 IWORH1= IWORH * 1.666666
785 WRITE(CHMAIL,11500)IWORH1
786 CALL GMAIL(0,0)
787 GOTO 320
788 ELSE IF(KCGST.EQ.-10)THEN
789 NWWS1 = NCLAS3+ 10
790 IWORW = NWWS1 - NWWS
791 IWORW1= IWORW * 2.5
792 WRITE(CHMAIL,11400)IWORW1
793 CALL GMAIL(0,0)
794 GOTO 320
795 ELSEIF(KCGST.EQ.-4.OR.KCGST.EQ.-1.OR.KCGST.EQ.-2) THEN
796* Exiting without having made evaluation of size
797 GOTO 320
798 ENDIF
799****SG
800* Case: Volume placed by GSPOS, not clipped and 'closed'
801*
802*XX
803* IF(NIN.GT.0.AND.(IMOD.EQ.0.OR.IMOD.EQ.3).
804* + AND.KSHIFT.EQ.0.AND.GBOOM.EQ.0.) GOTO 150
805*XX
806#endif
807 ELSE
808*
809* Standard Mode: Draw the shape
810*
811 CALL IGPID(1,'Pick',IVO,' ')
812 CALL IGPID(2,'Pick',IQ(JVOLUM+IVO),' ')
813 IF (ICUTFL.EQ.1) THEN
814 CALL GDRWSC(ISHAPE,GPAR(1,NLEVEL))
815 ELSE
816 CALL GDRAWS(ISHAPE,GPAR(1,NLEVEL))
817 ENDIF
818*
819 ENDIF
820*JS
821 JVO=LQ(JVOLUM-IVO)
822C
823 IF(SEEN.EQ.-2.)GO TO 270
824C
825 220 CONTINUE
826C
827*** IF (IDRNUM.NE.0) GO TO 999
828C
829C Skip User shapes (not yet implemented)
830C
831** ISEARC=Q(JVO+1)
832C
833C Now go down the tree
834C
835 NIN=Q(JVO+3)
836 IF(NIN.EQ.0) GO TO 270
837 IF(NIN.LT.0) GO TO 240
838C
839C Contents placed by GSPOS
840C
841 IN=0
842 IF(NLMAX.GT.NLEVEL) IN=LINDEX(NLEVEL+1)
843 IN=IN+1
844 IF(IN.GT.NIN.AND.NLEVEL.EQ.NLMIN) GO TO 300
845*
846 IF(IN.GT.NIN) GO TO 260
847*
848 CALL GMEPOS(JVO,IN,X,0)
849 JIN = LQ(JVO-IN)
850*
851 NPAR=IQ(JGPAR+NLEVEL)
852 DO 230 I=1,NPAR
853 GPAR(I,NLEVEL)=Q(LQ(JGPAR-NLEVEL)+I)
854 230 CONTINUE
855*
856 IVO=LVOLUM(NLEVEL)
857 JVO=LQ(JVOLUM-IVO)
858 NLMAX=NLEVEL
859 GO TO 110
860C
861 240 CONTINUE
862C
863C Contents by division
864C
865 IN=0
866 IF(NLMAX.GT.NLEVEL) IN=LINDEX(NLEVEL+1)
867 IN=IN+1
868 CALL GMEDIV(JVO,IN,X,0)
869 JIN = LQ(JVO-IN)
870*
871 IF (IN.EQ.0) GO TO 260
872*
873 NPAR=IQ(JGPAR+NLEVEL)
874 DO 250 I=1,NPAR
875 GPAR(I,NLEVEL)=Q(LQ(JGPAR-NLEVEL)+I)
876 250 CONTINUE
877*
878 IF (IN.EQ.0) GO TO 260
879*
880 IVO=LVOLUM(NLEVEL)
881 JVO=LQ(JVOLUM-IVO)
882 NLMAX=NLEVEL
883 GO TO 110
884C
885 260 CONTINUE
886 NLMAX=NLEVEL
887 270 CONTINUE
888 NLEVEL=NLEVEL-1
889 IF(NLEVEL.LT.NLMIN) GO TO 300
890 IVO=LVOLUM(NLEVEL)
891 JVO=LQ(JVOLUM-IVO)
892 GO TO 220
893C
894 280 WRITE(CHMAIL,10000)NAME
895 CALL GMAIL(0,0)
896 GO TO 300
897C
898 290 CONTINUE
899C
900C TOP OF THE TREE HAS PARAMETERS SET BY GSPOSP.
901C BUT GDRAW DOES NOT HAVE ACCESS TO THE IN BANK
902C WHICH PLACED IT IN ITS MOTHER.
903C
904 WRITE(CHMAIL,10100) NAME
905 CALL GMAIL(0,0)
906C
907 300 CONTINUE
908*
909***SG
910*
911#if defined(CERNLIB_CG)
912*
913* CG Mode
914*
915 IF(IHIDEN.EQ.IFLH) THEN
916*
917* In CG Mode the program flow has two scanning of the geometrical tree:
918* the first one is to count the number of volumes (IPAS=0);
919* the second one is to compute volumes' visibility with Hidden Volume
920* and Face Removal, inserting them in the Hide and Wire structures if
921* the size of Zebra store is sufficient (IPAS=1).
922*
923 IF(IPAS.EQ.0)THEN
924*
925* Creating a bank for setting line attributes volume by volume.
926* The number of words needed is just equal to the total number
927* of visible volumes.
928*
929 NCLAS2=NOBJ
930 IF(KGG.EQ.0)THEN
931 CALL MZNEED(IXCG,NCLAS2+10,'G')
932*
933* Take everything is left but leave 100,000 words just in case
934*
935 MEMO=IQUEST(11)-(IQUEST(11)*.11)
936 IF(IQUEST(11).LE.0)THEN
937 WRITE(CHMAIL,11300)NCLAS2+10
938 CALL GMAIL(0,0)
939 GOTO 320
940 ENDIF
941 CALL MZBOOK(IXCG,JCGCOL,JCGCOL, 1,'LINE',0,0,NCLAS2+10,
942 + 2,-1)
943 ENDIF
944 KGG=KGG+1
945 NOBJ=0
946 NUVO=0
947 IPAS=1
948*
949 NFILT=63000+NCLAS2+10
950*
951* Use max Zebra store for Hide and Wire structures
952*
953 NWHS=0.6*MEMO
954 NWWS=0.4*MEMO
955 CALL MZBOOK(IXCG,JCG,JCG,1,'CG',0,0,MEMO,3,-1)
956 CALL GDCGRS
957*
958 IHS=1
959 IHPOIN=JCG+1
960*
961* Creating the Hidden Structure
962*
963 IF(NWHS.LE.LHHEAD)NWHS=LHHEAD+1
964***SG
965 CALL CGHCRE(NTRCG,0,DUMMY,DUMMY,NWHS,Q(IHPOIN))
966 NTCUR=NWHS
967 IOLDCU=NTCUR
968 NFILT=NFILT+NTCUR
969 GOTO 40
970 ENDIF
971 IF(NOBJ.EQ.0)GOTO 320
972****SG
973* Closing the Hidden Structure
974*
975 IHPOIN=JCG+1
976*
977* Last size evaluation for Hide Structure
978*
979 CALL CGHEND(Q(IHPOIN),IFACST,RSHD)
980 IF(IFACST.GT.0)THEN
981 NWHS1 = IFACST+ 10
982 IWORH = NWHS1 - NWHS
983 IWORH1= IWORH * 1.666666
984 WRITE(CHMAIL,11500)IWORH1
985 CALL GMAIL(0,0)
986 GOTO 320
987 ENDIF
988*
989* IFACST shouldn't be negative now
990*
991 IF(IFACST.LT.0)THEN
992 WRITE(CHMAIL,10500)
993 CALL GMAIL(0,0)
994 GOTO 320
995 ENDIF
996*
997* Setting the right colours
998* and
999* Drawing the CG Objects
1000*
1001 IF(ILCG.LT.IFCG)THEN
1002 WRITE(CHMAIL,10400)
1003 CALL GMAIL(0,0)
1004 ELSE
1005 IF(LEP.GE.0.AND.ISPFLA.NE.1)THEN
1006 WRITE(CHMAIL,11900)
1007 CALL GMAIL(0,0)
1008 ENDIF
1009*** call write_dxf_sect_entity( 1 )
1010 DO 310 K=IFCG,ILCG
1011 IF(IDVIEW.NE.0)THEN
1012 IF(ILCG.GT.1000)THEN
1013 IPER=(100*K)/ILCG
1014 IF(IPER.EQ.10.OR.IPER.EQ.20.OR.IPER.EQ.30.OR.IPER.
1015 + EQ. 40.OR.IPER.EQ.50.OR.IPER.EQ.60.OR.IPER.EQ.70.O
1016 + R.IPER .EQ.80.OR.IPER.EQ.90)THEN
1017 IF(IPER.NE.IPEOLD)THEN
1018 WRITE(CHMAIL,12000)IPER
1019 CALL GMAIL(0,0)
1020 IPEOLD=IPER
1021 ENDIF
1022 ENDIF
1023 ENDIF
1024 ENDIF
1025 LINATT=IQ(JCGCOL+K-IFCG+1)
1026 IWPOIN=JCG+IQ(JCOUNT+K)
1027 IF(ISPFLA.EQ.1)ISPFLA=2
1028 IF(LLEP.NE.1)THEN
1029 MMPOIN=IMPOIN+IQ(IMCOUN+K)
1030 CALL GD16V((IQ(JCOUNT+K)-1),IQ(MMPOIN))
1031 ELSE
1032 CALL GD16V((IQ(JCOUNT+K)-1),0)
1033 ENDIF
1034 IF(ISPFLA.EQ.2)ISPFLA=1
1035 310 CONTINUE
1036 ENDIF
1037*** call write_dxf_sect_entity( 2 )
1038*
1039* Printing statistics
1040*
1041 IF(LEP.GE.0.AND.ISPFLA.NE.1)THEN
1042 NFILT=NFILT-NWHS+RSHD
1043 INFILT=NFILT
1044 IRSHD=RSHD
1045 MEMO1=MEMO+63000+NCLAS2+10+JMEMT2+JMEMT1+JMEMT3+54000
1046 RSWR =NFILT-RSHD-63000-NCLAS2-10
1047 IRSWR=RSWR
1048 ICGOB=63000
1049 RATIO=RSHD/RSWR
1050 JJIIKK=0
1051 JPARGE=0
1052 IF(LLEP.NE.1)THEN
1053 JJIIKK=ILCG-IFCG+1
1054 JPARGE=54000
1055 ENDIF
1056 WRITE(CHMAIL,10600)INFILT+NTNEX+ILCG-IFCG+1+JJIIKK+JPARGE
1057 CALL GMAIL(0,0)
1058 WRITE(CHMAIL,10700)MEMO1
1059 CALL GMAIL(0,0)
1060 WRITE(CHMAIL,10900)NCLAS2+10
1061 CALL GMAIL(0,0)
1062 WRITE(CHMAIL,10800)ICGOB
1063 CALL GMAIL(0,0)
1064 WRITE(CHMAIL,11000)IRSHD
1065 CALL GMAIL(0,0)
1066 WRITE(CHMAIL,11100)IRSWR+ILCG-IFCG+1
1067 CALL GMAIL(0,0)
1068 WRITE(CHMAIL,11200)NTNEX+JJIIKK+JPARGE
1069 CALL GMAIL(0,0)
1070* WRITE(CHMAIL,10799)RATIO
1071* CALL GMAIL(0,0)
1072 WRITE(CHMAIL,11600)ILCG-IFCG+1
1073 CALL GMAIL(0,0)
1074 WRITE(CHMAIL,11700)NCLAS2
1075 CALL GMAIL(0,0)
1076 ENDIF
1077*
1078 ENDIF
1079*
1080* Dropping + resetting parameters
1081*
1082 320 CONTINUE
1083 IF(IHIDEN.EQ.IFLH)THEN
1084 ICUT=0
1085 IF(JCG.NE.0)CALL MZDROP(IXSTOR,JCG,' ')
1086 IF(JCGOBJ.NE.0)CALL MZDROP(IXSTOR,JCGOBJ,' ')
1087 CALL GDCGRS
1088 IF(JCGCOL.NE.0)CALL MZDROP(IXSTOR,JCGCOL,' ')
1089 IF(JCOUNT.NE.0)CALL MZDROP(IXSTOR,JCOUNT,' ')
1090 IF(JCLIPS.NE.0)CALL MZDROP(IXSTOR,JCLIPS,' ')
1091 IF(IMPOIN.NE.0)CALL MZDROP(IXSTOR,IMPOIN,' ')
1092 IF(IMCOUN.NE.0)CALL MZDROP(IXSTOR,IMCOUN,' ')
1093 IF(JSIX.NE.0) CALL MZDROP(IXSTOR, JSIX, ' ')
1094 IF(JSIY.NE.0) CALL MZDROP(IXSTOR, JSIY, ' ')
1095 IF(JSIZ.NE.0) CALL MZDROP(IXSTOR, JSIZ, ' ')
1096 IF(JPXC.NE.0) CALL MZDROP(IXSTOR, JPXC, ' ')
1097 IF(JPYC.NE.0) CALL MZDROP(IXSTOR, JPYC, ' ')
1098 IF(JPZC.NE.0) CALL MZDROP(IXSTOR, JPZC, ' ')
1099 LARECG(1)=0
1100 CALL MZGARB(IXSTOR+1,0)
1101* NWHS1=0
1102* NWFLAG=0
1103 NCLAS1=0
1104 NCLAS2=0
1105 NCLAS3=0
1106 ENDIF
1107*
1108****SG
1109*
1110#endif
1111 IF (IFCVOL.EQ.1) THEN
1112 CALL GFCVOL
1113 ELSE
1114 NLEVEL=0
1115 ENDIF
1116C
1117C If in cut-mode then close the GDRAWV line buffer
1118C
1119 IF (ICUTFL.EQ.1) CALL GDRAWV(0.,0.,0)
1120C
1121C Restore permanent value of color and return
1122C
1123* CALL GDCOL(0)
1124 IOBJ=0
1125C
112610000 FORMAT(' *** GDRAW *** : Volume ',A4,' does not exist')
112710100 FORMAT(' *** GDRAW *** : Top of tree ',A4,' parameters defined',
1128 + ' by GSPOSP - info not available to GDRAW.')
112910200 FORMAT(' *** GDRAW *** : Illegal Transformation Matrix',
1130 + ' Number NTRCG ')
113110300 FORMAT(' *** GDRAW *** : >>> Det (T) = 0 ')
113210400 FORMAT(' *** GDRAW *** : Warning! Volume is destroyed.')
1133*SG
113410500 FORMAT(' *** GDRAW *** : Internal error, please report to',
1135 + ' GEANT support team')
113610600 FORMAT(' *** GDRAW *** : Total memory used =',I10,' words.')
113710700 FORMAT(' *** GDRAW *** : Total memory booked =',I10,' words.')
113810800 FORMAT(' *** GDRAW *** : Memory used for CGOB =',I10,' words.')
113910900 FORMAT(' *** GDRAW *** : Memory used for LINE =',I10,' words.')
114011000 FORMAT(' *** GDRAW *** : Memory used for HIDE =',I10,' words.')
114111100 FORMAT(' *** GDRAW *** : Memory used for WIRE =',I10,' words.')
114211200 FORMAT(' *** GDRAW *** : Memory used for SHAD =',I10,' words.')
114311300 FORMAT(' *** GDRAW *** : Memory needed for the LINE attributes',
1144 + ' =',I10,' words.')
1145*10799 FORMAT(' *** GDRAW *** : HIDE/WIRE=',F4.2,'.')
114611400 FORMAT(' *** GDRAW *** : Please, increase size of Zebra store',
1147 + ' by',I10,' words to create WIRE structure.')
114811500 FORMAT(' *** GDRAW *** : Please, increase size of Zebra store',
1149 + ' by',I10,' words to create HIDE structure.')
115011600 FORMAT(' *** GDRAW *** : Visible volumes =',I10,'.')
115111700 FORMAT(' *** GDRAW *** : Total volumes =',I10,'.')
115211800 FORMAT(' *** GDRAW *** :',I2,'% of volumes analysed.')
115311900 FORMAT(' *** GDRAW *** : Now the drawing is starting !')
115412000 FORMAT(' *** GDRAW *** :',I2,'% of volumes drawn.')
1155*
1156*SG
1157 END