]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gxint/gxdraw.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gxint / gxdraw.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:21:49 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 28/03/94 01.30.59 by S.Giani
11*-- Author :
12 SUBROUTINE GXDRAW
13C.
14C. ******************************************************************
15C. * *
16C. * Drawing commands *
17C. * *
18C. * Authors: R.Brun ********** *
19C. * P.Zanarini ********** *
20C. * S.Giani ********** *
21C. * *
22C. ******************************************************************
23C.
24#include "geant321/gcbank.inc"
25#include "geant321/pawc.inc"
26#include "geant321/gcunit.inc"
27#include "geant321/gcdraw.inc"
28#include "geant321/gcgobj.inc"
29#include "geant321/gcmutr.inc"
30#include "geant321/gcspee.inc"
31#include "geant321/gccurs.inc"
32#include "geant321/gchil2.inc"
33#include "geant321/gcursb.inc"
34#if defined(CERNLIB_USRJMP)
35#include "geant321/gcjump.inc"
36#endif
37#include "geant321/gcvdma.inc"
38#include "geant321/gcfdim.inc"
39*
40 COMMON/QUEST/IQUEST(100)
41*
42 DIMENSION NNAME(15),NNUMB(15),RVAL(2)
43*SG
44 DIMENSION VX(4),VXX(4),VVX(4),XV(4),BX(4)
45 DIMENSION VY(4),VYY(4),VVY(4),YV(4),BY(4)
46 CHARACTER*4 NAME,CHNUMB,IDS,IVS,ICS,NNVV,NVNV,MOTH
47 CHARACTER*4 CHNRS,CHAX,YESNO,CENT
48 CHARACTER*4 NOPT,SAMP,KSAM,KLSA
49 CHARACTER*6 MODE
50
51*SG
52 CHARACTER*80 CHTEXT
53 CHARACTER*32 CHPATL,VNAME
54 CHARACTER*64 NAMNUM
55C.
56C. ------------------------------------------------------------------
57C.
58 CALL KUPATL(CHPATL,NPAR)
59*
60 IF (CHPATL.EQ.'BOX ') THEN
61 IHOLE=0
62*
63* It's now possible to clip different volumes by different SHAPES !
64* Moreover, one can clip twice each volume by different SHAPES !
65*
66 NCVOLS=NCVOLS+1
67 IF(NCVOLS.EQ.MULTRA)THEN
68 WRITE(CHMAIL, 10000)
6910000 FORMAT(' *** GXDRAW ***:',
70 + ' No more space to store MCVOL information.')
71 CALL GMAIL(0,0)
72 WRITE(CHMAIL, 10100)
7310100 FORMAT(' *** GXDRAW ***: Please reset MCVOL')
74 CALL GMAIL(0,0)
75 GOTO 999
76 ENDIF
77 CALL KUGETC(NNVV,NCH)
78***SG
79 CALL KUGETR(XMIN)
80 CALL KUGETR(XMAX)
81 CALL KUGETR(YMIN)
82 CALL KUGETR(YMAX)
83 CALL KUGETR(ZMIN)
84 CALL KUGETR(ZMAX)
85 IF(XMIN.GE.XMAX.OR.YMIN.GE.YMAX.OR.ZMIN.GE.ZMAX)THEN
86 WRITE(CHMAIL,10200)
8710200 FORMAT(' Wrong Box limits. Check values ')
88 CALL GMAIL(0,0)
89 GOTO 999
90 ENDIF
91****SG
92 GNNVV(NCVOLS)=NNVV
93 GNASH(NCVOLS)='BOX'
94 GXMIN(NCVOLS)=XMIN
95 GXMAX(NCVOLS)=XMAX
96 GYMIN(NCVOLS)=YMIN
97 GYMAX(NCVOLS)=YMAX
98 GZMIN(NCVOLS)=ZMIN
99 GZMAX(NCVOLS)=ZMAX
100 IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1
101* Resetting Mcvol mode
102 IF(GNNVV(NCVOLS).EQ.'.')THEN
103 IHOLE=0
104 DO 10 JJ=1,NCVOLS
105 GNNVV(JJ)=' '
106 GXMIN(JJ)=-100000
107 GXMAX(JJ)=-99999
108 GYMIN(JJ)=-100000
109 GYMAX(JJ)=-99999
110 GZMIN(JJ)=-100000
111 GZMAX(JJ)=-99999
112 10 CONTINUE
113 NCVOLS=0
114 ENDIF
115 ELSEIF (CHPATL.EQ.'TUBE')THEN
116 IHOLE=0
117*
118* It's now possible to clip different volumes by different SHAPES !
119* Moreover, one can clip twice each volume by different SHAPES !
120*
121 NCVOLS=NCVOLS+1
122 IF(NCVOLS.EQ.MULTRA)THEN
123 WRITE(CHMAIL, 10000)
124 CALL GMAIL(0,0)
125 WRITE(CHMAIL, 10100)
126 CALL GMAIL(0,0)
127 GOTO 999
128 ENDIF
129 CALL KUGETC(NNVV,NCH)
130***SG
131 CALL KUGETR(RMAX)
132 CALL KUGETR(ZDEM)
133 CALL KUGETR(XMED)
134 CALL KUGETR(YMED)
135 CALL KUGETR(ZMED)
136****SG
137 GNNVV(NCVOLS)=NNVV
138 GNASH(NCVOLS)='TUBE'
139 GXMIN(NCVOLS)=RMAX
140 GXMAX(NCVOLS)=ZDEM
141 GYMIN(NCVOLS)=XMED
142 GYMAX(NCVOLS)=YMED
143 GZMIN(NCVOLS)=ZMED
144 GZMAX(NCVOLS)=0.
145 IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1
146*Resetting Mcvol mode
147 IF(GNNVV(NCVOLS).EQ.'.')THEN
148 IHOLE=0
149 DO 20 JJ=1,NCVOLS
150 GNNVV(JJ)=' '
151 GXMIN(JJ)=0.1
152 GXMAX(JJ)=0.1
153 GYMIN(JJ)=-100000
154 GYMAX(JJ)=-100000
155 GZMIN(JJ)=-100000
156 GZMAX(JJ)=0.
157 20 CONTINUE
158 NCVOLS=0
159 ENDIF
160
161 ELSEIF (CHPATL.EQ.'CONE')THEN
162 IHOLE=0
163*
164* It's now possible to clip different volumes by different SHAPES !
165* Moreover, one can clip twice each volume by different SHAPES !
166*
167 NCVOLS=NCVOLS+1
168 IF(NCVOLS.EQ.MULTRA)THEN
169 WRITE(CHMAIL, 10000)
170 CALL GMAIL(0,0)
171 WRITE(CHMAIL, 10100)
172 CALL GMAIL(0,0)
173 GOTO 999
174 ENDIF
175 CALL KUGETC(NNVV,NCH)
176***SG
177 CALL KUGETR(RMAX1)
178 CALL KUGETR(RMAX2)
179 CALL KUGETR(ZDEM)
180 CALL KUGETR(XMED)
181 CALL KUGETR(YMED)
182 CALL KUGETR(ZMED)
183****SG
184 GNNVV(NCVOLS)=NNVV
185 GNASH(NCVOLS)='CONE'
186 GXMIN(NCVOLS)=RMAX1
187 GXMAX(NCVOLS)=RMAX2
188 GYMIN(NCVOLS)=ZDEM
189 GYMAX(NCVOLS)=XMED
190 GZMIN(NCVOLS)=YMED
191 GZMAX(NCVOLS)=ZMED
192 IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1
193*Resetting Mcvol mode
194 IF(GNNVV(NCVOLS).EQ.'.')THEN
195 IHOLE=0
196 DO 30 JJ=1,NCVOLS
197 GNNVV(JJ)=' '
198 GXMIN(JJ)=0.1
199 GXMAX(JJ)=0.1
200 GYMIN(JJ)=0.1
201 GYMAX(JJ)=-100000
202 GZMIN(JJ)=-100000
203 GZMAX(JJ)=-100000
204 30 CONTINUE
205 NCVOLS=0
206 ENDIF
207
208 ELSEIF (CHPATL.EQ.'SPHE')THEN
209 IHOLE=0
210*
211* It's now possible to clip different volumes by different SHAPES !
212* Moreover, one can clip twice each volume by different SHAPES !
213*
214 NCVOLS=NCVOLS+1
215 IF(NCVOLS.EQ.MULTRA)THEN
216 WRITE(CHMAIL, 10000)
217 CALL GMAIL(0,0)
218 WRITE(CHMAIL, 10100)
219 CALL GMAIL(0,0)
220 GOTO 999
221 ENDIF
222 CALL KUGETC(NNVV,NCH)
223***SG
224 CALL KUGETR(RMAX)
225 CALL KUGETR(XMED)
226 CALL KUGETR(YMED)
227 CALL KUGETR(ZMED)
228****SG
229 GNNVV(NCVOLS)=NNVV
230 GNASH(NCVOLS)='SPHE'
231 GXMIN(NCVOLS)=RMAX
232 GXMAX(NCVOLS)=XMED
233 GYMIN(NCVOLS)=YMED
234 GYMAX(NCVOLS)=ZMED
235 IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1
236*Resetting Mcvol mode
237 IF(GNNVV(NCVOLS).EQ.'.')THEN
238 IHOLE=0
239 DO 40 JJ=1,NCVOLS
240 GNNVV(JJ)=' '
241 GXMIN(JJ)=0.1
242 GXMAX(JJ)=-100000
243 GYMIN(JJ)=-100000
244 GYMAX(JJ)=-100000
245 40 CONTINUE
246 NCVOLS=0
247 ENDIF
248*
249 ELSEIF (CHPATL.EQ.'VALCUT') THEN
250 CALL KUGETR(XCUT)
251 CALL KUGETR(YCUT)
252 CALL KUGETR(ZCUT)
253*
254 ELSEIF (CHPATL.EQ.'SPOT') THEN
255 CALL KUGETR(XLPOS)
256 CALL KUGETR(YLPOS)
257 CALL KUGETR(ZLPOS)
258 CALL KUGETI(INTEN)
259 CALL GLIGHT(XLPOS,YLPOS,ZLPOS,INTEN)
260*
261 ELSEIF (CHPATL.EQ.'VAR5D') THEN
262 CALL KUGETR(TSEQTO)
263 CALL KUGETI(NPROC)
264 CALL KUGETI(NMPTOT)
265 CALL KUGETR(TOTMBY)
266 CALL KUGETR(TSEQ)
267 CALL KUGETR(TLAT)
268 CALL KUGETR(TNET)
269*
270 ELSEIF (CHPATL.EQ.'RANG5D') THEN
271 CALL KUGETR(X1MIN)
272 CALL KUGETR(X1MAX)
273 CALL KUGETR(Y1MIN)
274 CALL KUGETR(Y1MAX)
275 CALL KUGETR(Z1MIN)
276 CALL KUGETR(Z1MAX)
277*
278 ELSEIF (CHPATL.EQ.'DRAW') THEN
279 CALL KUGETC(NAME,NCH)
280 CALL KUGETR(GTHETA)
281 CALL KUGETR(GPHI)
282 CALL KUGETR(GPSI)
283 CALL KUGETR(GU0)
284 CALL KUGETR(GV0)
285 CALL KUGETR(GSCU)
286 CALL KUGETR(GSCV)
287 GTHETL=GTHETA
288 GPHIL=GPHI
289 GPSIL=GPSI
290 GU0L=GU0
291 GV0L=GV0
292 GSCUL=GSCU
293 GSCVL=GSCV
294 IF(RAYTRA.EQ.1.)THEN
295 CALL GDRAYT(NAME,GTHETL,GPHIL,GPSIL,GU0L,GV0L,GSCUL,GSCVL)
296 ELSE
297 CALL GDRAW(NAME,GTHETL,GPHIL,GPSIL,GU0L,GV0L,GSCUL,GSCVL)
298 ENDIF
299*
300 ELSEIF (CHPATL.EQ.'DVOLUME') THEN
301 CALL KUGETI(N)
302 IF (N.EQ.0) GO TO 60
303 IF (N.LT.0.OR.N.GT.15) GO TO 999
304*
305 CALL KUGETC(CHTEXT,NCH)
306 DO 50 I=1,N
307 CALL KUGETL(NAMNUM,NCH)
308 CALL UCTOH(NAMNUM,NNAME(I),4,4)
309 CALL KUGETL(CHNUMB,NCH)
310 CALL KICTON(CHNUMB,NNUMB(I),RVAL)
311 IF (IQUEST(1).NE.0) GO TO 999
312 50 CONTINUE
313*
314 CALL KUGETC(CHNRS,NCH)
315 NRS=0
316 IF (CHNRS.EQ.'DRS') NRS=1
317 CALL KUGETR(GTHETA)
318 CALL KUGETR(GPHI)
319 CALL KUGETR(GPSI)
320 CALL KUGETR(GU0)
321 CALL KUGETR(GV0)
322 CALL KUGETR(GSCU)
323 CALL KUGETR(GSCV)
324 60 CALL GDRVOL(N,NNAME,NNUMB,NRS,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,
325 + GSCV)
326*
327 ELSEIF (CHPATL.EQ.'DCUT') THEN
328 IHOLE=0
329 CALL KUGETC(NAME,NCH)
330 CALL KUGETC(CHAX,NCH)
331 IF (CHAX.EQ.'X'.OR.CHAX.EQ.'1') THEN
332 IAX=1
333 ELSEIF (CHAX.EQ.'Y'.OR.CHAX.EQ.'2')THEN
334 IAX=2
335 ELSEIF (CHAX.EQ.'Z'.OR.CHAX.EQ.'3')THEN
336 IAX=3
337 ENDIF
338 CALL KUGETR(CCUT)
339 CALL KUGETR(GU0)
340 CALL KUGETR(GV0)
341 CALL KUGETR(GSCU)
342 CALL KUGETR(GSCV)
343 CALL GDRAWC(NAME,IAX,CCUT,GU0,GV0,GSCU,GSCV)
344*
345 ELSEIF (CHPATL.EQ.'DXCUT') THEN
346 CALL KUGETC(NAME,NCH)
347 CALL KUGETR(CUTTHE)
348 CALL KUGETR(CUTPHI)
349 CALL KUGETR(CCUT)
350 CALL KUGETR(GTHETA)
351 CALL KUGETR(GPHI)
352 CALL KUGETR(GU0)
353 CALL KUGETR(GV0)
354 CALL KUGETR(GSCU)
355 CALL KUGETR(GSCV)
356 CALL GDRAWX(NAME,CUTTHE,CUTPHI,CCUT,GTHETA,GPHI,GU0,GV0,GSCU,
357 + GSCV)
358*
359***SG
360*
361*
362* It's now possible to shift each volume into a more visible place !
363*
364 ELSEIF(CHPATL.EQ.'SHIFT') THEN
365 IF(NSHIFT.EQ.0)KSHIFT=1
366 NSHIFT=NSHIFT+1
367 IF(NSHIFT.EQ.MULTRA)THEN
368 WRITE(CHMAIL, 10300)
36910300 FORMAT(' *** GXDRAW ***:',
370 + ' No more space to store SHIFT information.')
371 CALL GMAIL(0,0)
372 GOTO 999
373 ENDIF
374 CALL KUGETC(NVNV,NCH)
375 CALL KUGETR(XXXX)
376 CALL KUGETR(YYYY)
377 CALL KUGETR(ZZZZ)
378 GNVNV(NSHIFT)=NVNV
379 GXXXX(NSHIFT)=XXXX
380 GYYYY(NSHIFT)=YYYY
381 GZZZZ(NSHIFT)=ZZZZ
382* Resetting Shift mode
383 IF(GNVNV(NSHIFT).EQ.'.')THEN
384 KSHIFT=0
385 DO 70 KK=1,NSHIFT
386 GNVNV(KK)=' '
387 GXXXX(KK)=0
388 GYYYY(KK)=0
389 GZZZZ(KK)=0
390 70 CONTINUE
391 NSHIFT=0
392 ENDIF
393*
394* To make the detector 'explode'
395*
396 ELSEIF(CHPATL.EQ.'BOMB')THEN
397 CALL KUGETR(BOOM)
398 GBOOM=BOOM
399*
400***SG
401*
402 ELSEIF (CHPATL.EQ.'DTREE') THEN
403* JSIM=0
404 KXXX=0
405 NNPAR=NPAR
406 CALL KUGETC(NAME,NCH)
407 CALL UHTOC(IQ(JVOLUM+1),4,MOMO,4)
408 CALL KUGETI(LEVMAX)
409 IF(NNPAR.EQ.3)THEN
410 CALL KUGETI(ISELT)
411 IISELT=ISELT
412 ELSE
413 ISELT=111
414 ENDIF
415 IWTY=IGIWTY(1)
416 JVSIM=2
417 IF(IWTY.GT.10.OR.IWTY.LT.1)JVSIM=1
418 IF (NAME.EQ.' ')NAME=MOMO
419 IF (NAME.NE.MOMO) THEN
420 INTFLA=10
421 CALL GDTREE(MOMO,0,110)
422 DO 80 J=1,NUMND2
423 IQ(JFINAM+J)=IQ(JNAM1+J)
424 IQ(JFISCA+J)=IQ(JSCA1+J)
425 IQ(JFIMOT+J)=IQ(JMOT1+J)
426 80 CONTINUE
427 KXXX=1
428 IF(LEVMAX.LT.0)THEN
429 LEVMAX=-LEVMAX
430 DO 90 II=1,LEVMAX
431 CALL GDTR8(NAME,MOTH,IONL)
432 NAME=MOTH
433 90 CONTINUE
434 LEVMAX=3
435 ENDIF
436 ELSE
437 INTFLA=10
438 CALL GDTREE(NAME,0,110)
439 DO 100 J=1,NUMND2
440 IQ(JFINAM+J)=IQ(JNAM1+J)
441 IQ(JFISCA+J)=IQ(JSCA1+J)
442 IQ(JFIMOT+J)=IQ(JMOT1+J)
443 100 CONTINUE
444 INTFLA=-1
445 CALL GDTREE(NAME,LEVMAX,ISELT)
446 ENDIF
447*
448 CALL GDPLST(JVSIM,NAME,LEVMAX,KXXX)
449*
450 ELSEIF (CHPATL.EQ.'DSPEC') THEN
451 CALL KUGETC(NAME,NCH)
452 CALL GDSPEC(NAME)
453*
454 ELSEIF (CHPATL.EQ.'D3DSPEC') THEN
455 CALL KUGETC(NAME,NCH)
456 CALL KUGETR(TETA3)
457 CALL KUGETR(PHI3)
458 CALL KUGETR(PSI3)
459 CALL KUGETR(U03)
460 CALL KUGETR(V03)
461 CALL KUGETR(ZM3)
462 CALL GSPE3D(NAME,TETA3,PHI3,PSI3,U03,V03,ZM3)
463*
464 ELSEIF (CHPATL.EQ.'DFSPC') THEN
465 CALL KUGETC(NAME,NCH)
466 ISORT=0
467 CALL KUGETC(YESNO,NCH)
468 IF (YESNO.EQ.'Y') ISORT=1
469 INTER=1
470 CALL KUGETC(MODE,NCH)
471 IF (MODE.EQ.'B') INTER=0
472 CALL GDFSPC(NAME,ISORT,INTER)
473*
474 ELSEIF (CHPATL.EQ.'DTEXT') THEN
475 CALL KUGETR(X0)
476 CALL KUGETR(Y0)
477 CALL KUGETS(CHTEXT,NCH)
478 CALL KUGETR(SIZE)
479 CALL KUGETR(ANGLE)
480 CALL KUGETI(LWID)
481 CALL KUGETC(CENT,NCH)
482 IF (CENT.EQ.'LEFT'.OR.CENT.EQ.'-1') THEN
483 IOPT=-1
484 ELSEIF (CENT.EQ.'RIGHT'.OR.CENT.EQ.'1') THEN
485 IOPT=1
486 ELSE
487 IOPT=0
488 ENDIF
489 CALL IGSET('TXFP',-60.)
490 IWTY=IGIWTY(1)
491 IF(IWTY.GT.10.OR.IWTY.LT.1)CALL IGSET('TXFP',-61.)
492 CALL GDRAWT(X0,Y0,CHTEXT,SIZE,ANGLE,LWID,IOPT)
493 CALL IGSET('TXFP',2.)
494*
495 ELSEIF (CHPATL.EQ.'DVECTOR') THEN
496 CALL KUGETV(VNAME,LPARX,LLL)
497 CALL KUGETV(VNAME,LPARY,LLL)
498 CALL KUGETI(NP)
499 CALL GDRAWV(QQ(LPARX),QQ(LPARY),NP)
500*
501 ELSEIF (CHPATL.EQ.'DSCALE') THEN
502 CALL KUGETR(X0)
503 CALL KUGETR(Y0)
504 CALL GDSCAL(X0,Y0)
505*
506 ELSEIF (CHPATL.EQ.'DAXIS') THEN
507 CALL KUGETR(XX0)
508 CALL KUGETR(YY0)
509 CALL KUGETR(ZZ0)
510 CALL KUGETR(DDX)
511 CALL GDAXIS(XX0,YY0,ZZ0,DDX)
512*
513 ELSEIF (CHPATL.EQ.'DMAN') THEN
514 CALL KUGETR(U0)
515 CALL KUGETR(V0)
516 CALL KUGETC(MODE,NCH)
517 IF (MODE.EQ.'WM1') THEN
518 CALL GDWMN1(U0,V0)
519 ELSE IF (MODE.EQ.'WM3') THEN
520 CALL GDWMN3(U0,V0)
521 ELSE IF (MODE.EQ.'WM2') THEN
522 CALL GDWMN2(U0,V0)
523 ELSE IF (MODE.EQ.'MAN') THEN
524 CALL GDMAN(U0,V0)
525 ENDIF
526*
527 ELSEIF (CHPATL.EQ.'DHEAD') THEN
528 ISELH=111110
529 CALL KUGETI(ISELH)
530 CHRSIZ=0.6
531 CALL KUGETS(CHTEXT,NCH)
532 CALL KUGETR(CHRSIZ)
533 CALL GDHEAD(ISELH,CHTEXT,CHRSIZ)
534*
535 ELSEIF (CHPATL.EQ.'MEASURE') THEN
536 CALL IGLOC2(1,NT,U0,V0,U1,V1,ISTAT,'L')
537 IF (ISTAT.EQ.0) GO TO 999
538 UDIST=(U1-U0)/(GSCU*GZUA)
539 VDIST=(V1-V0)/(GSCV*GZVA)
540 DIST=SQRT(UDIST*UDIST+VDIST*VDIST)
541 WRITE (CHMAIL,'('' MEASURE : '',F9.4,'' CM'')') DIST
542 CALL GMAIL(0,0)
543*
544 ELSEIF (CHPATL.EQ.'MOVE') THEN
545 IWTY=IGIWTY(1)
546 IF(IWTY.LE.10.AND.IWTY.GE.1)THEN
547 ISTAT=0
548 LEP=-ABS(LEP)
549 CALL KUGETC(NAME,NCH)
550 CALL KUGETC(NOPT,NCH)
551 VX(1)=0.
552 VX(2)=4.
553 VX(3)=4.
554 VX(4)=0.
555 VY(1)=0.
556 VY(2)=0.
557 VY(3)=1.
558 VY(4)=1.
559 VXX(1)=4.
560 VXX(2)=8.
561 VXX(3)=8.
562 VXX(4)=4.
563 VYY(1)=0.
564 VYY(2)=0.
565 VYY(3)=1.
566 VYY(4)=1.
567 VVX(1)=8.
568 VVX(2)=12.
569 VVX(3)=12.
570 VVX(4)=8.
571 VVY(1)=0.
572 VVY(2)=0.
573 VVY(3)=1.
574 VVY(4)=1.
575 XV(1)=12.
576 XV(2)=16.
577 XV(3)=16.
578 XV(4)=12.
579 YV(1)=0.
580 YV(2)=0.
581 YV(3)=1.
582 YV(4)=1.
583 BX(1)=16.
584 BX(2)=20.
585 BX(3)=20.
586 BX(4)=16.
587 BY(1)=0.
588 BY(2)=0.
589 BY(3)=1.
590 BY(4)=1.
591***** CALL IGSET('DRMD',2.)
592 CALL ISFAIS(1)
593 CALL GDCOL1(2)
594 CALL IFA(4,VX,VY)
595 CALL GDCOL1(3)
596 CALL IFA(4,VXX,VYY)
597 CALL GDCOL1(4)
598 CALL IFA(4,VVX,VVY)
599 CALL GDCOL1(6)
600 CALL IFA(4,XV,YV)
601 CALL GDCOL1(7)
602 CALL IFA(4,BX,BY)
603 AITXCO=5.
604 CALL IGSET('TXCI',AITXCO)
605 CALL IGSET('TXFP',-60.)
606 CALL GDRAWT(2.,.2,'THETA',.7,0.,4,0)
607 CALL GDRAWT(6.,.2,'PHI',.7,0.,4,0)
608 CALL GDRAWT(10.,.2,'TRASL',.7,0.,4,0)
609 CALL GDRAWT(14.,.2,'ZOOM',.7,0.,4,0)
610 CALL GDRAWT(18.,.2,'OFF',.7,0.,4,0)
611 CALL IGSET('TXFP',2.)
612 LLEP=ABS(LEP)
613 IF(LLEP.GT.1)THEN
614 LCLC=1
615 ELSE
616 LCLC=0
617 ENDIF
618 CALL ISFACI(LCLC)
619 CALL IGBOX(0.,20.,20.,1.)
620 CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV)
621 IOPTS = INDEX(NOPT,'S')+INDEX(NOPT,'s')
622 IOPTT = INDEX(NOPT,'T')+INDEX(NOPT,'t')
623 IOPTH = INDEX(NOPT,'H')+INDEX(NOPT,'h')
624 IF(IOPTT.NE.0) CALL GDXYZ(0)
625 IF(IOPTH.NE.0) CALL GDHITS('*','*',0,0,.2)
626 MO=2
627* OOY2=10.
628* OOX2=10.
629 OGSCU=GSCU
630 OGSCV=GSCV
631* ipx=1
632 CALL IGQWK(1,'MXDS',RVAL)
633 IXXX=RVAL(1)
634 IYYY=RVAL(2)
635 IYYY1=(IYYY*19.)/20.
636 DO 110 J=1,1000000
637 IF(ISTAT.EQ.2.AND.IOPTT.NE.0) CALL GKXYZ(-.25)
638 IF(ISTAT.EQ.2.AND.IOPTH.NE.0) CALL GKHITS('*','*',-.1)
639 CALL IRQLC(1,MO,ISTAT,NT,X2,Y2)
640* CALL ISFAIS(1)
641***** CALL IGSET('DRMD',2.)
642 IF(MO.NE.-2)THEN
643 IF(X2.GT.0..AND.X2.LT.4..AND.Y2.LT.1.)NBAR=1
644 IF(X2.GT.4..AND.X2.LT.8..AND.Y2.LT.1.)NBAR=2
645 IF(X2.GT.8..AND.X2.LT.12..AND.Y2.LT.1.)NBAR=3
646 IF(X2.GT.12..AND.X2.LT.16..AND.Y2.LT.1.)NBAR=4
647 IF(X2.GT.16..AND.X2.LT.20..AND.Y2.LT.1.)THEN
648 CALL IGSET('DRMD',1.)
649 LEP=-LEP
650 GO TO 999
651 ENDIF
652 ENDIF
653* YY22=ABS(Y2-OOY2)
654 IF(NBAR.EQ.1) THEN
655 GTHETA=18.*Y2
656 IF(IOPTS.NE.0) MO=-2
657 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2
658* IF(YY22.LT..2)GOTO 177
659* OOY2=Y2
660 ELSEIF(NBAR.EQ.2) THEN
661* GBOOM=Y2/10.
662 GPHI=18.*Y2
663 IF(IOPTS.NE.0) MO=-2
664 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2
665* IF(YY22.LT..2)GOTO 177
666* OOY2=Y2
667 ELSEIF(NBAR.EQ.3) THEN
668* XX22=ABS(X2-OOY2)
669 GU0=X2
670 GV0=Y2
671*** GTHETA=18.*Y2
672*** GPHI=18.*Y2
673 IF(IOPTS.NE.0) MO=-2
674 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2
675* IF(YY22.LT..2.AND.XX22.LT..2)GOTO 177
676* OOY2=Y2
677* OOX2=X2
678 ELSEIF(NBAR.EQ.4) THEN
679 GSCU=OGSCU*Y2*.25
680 GSCV=OGSCV*Y2*.25
681 IF(IOPTS.NE.0) MO=-2
682 IF(ISTAT.EQ.0.OR.ISTAT.EQ.2)MO=2
683* IF(YY22.LT..2)GOTO 177
684* OOY2=Y2
685 ENDIF
686***** CALL IGSET('DRMD',1.)
687 CALL IGPXMP(IPX,IXXX,IYYY1,'O')
688 CALL ISFACI(LCLC)
689 IF(LCLC.NE.0)CALL IGBOX(0.,20.,20.,1.)
690 CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV)
691 IF(IOPTT.NE.0) CALL GDXYZ(0)
692 IF(IOPTH.NE.0) CALL GDHITS('*','*',0,0,.2)
693 CALL IGPXMP(IPX,0,0,'CDR')
694** CALL GDRAW(NAME,SGT1,SGT2,SGT3,SGT4,SGT5,SGT6,SGT7)
695* CALL GDXYZ(0)
696* CALL GDHITS('*','*',0,-1,.4)
697 110 CONTINUE
698 ENDIF
699*
700 ELSEIF (CHPATL.EQ.'MOVE3D') THEN
701 CALL KUGETC(NAME,NCH)
702 CALL KUGETR(GTHETA)
703 CALL KUGETR(GPHI)
704 CALL KUGETR(GPSI)
705 CALL KUGETR(GU0)
706 CALL KUGETR(GV0)
707 CALL KUGETR(GSCU)
708 CALL KUGETR(GSCV)
709 CALL KUGETR(GSCZ)
710 CALL KUGETC(NOPT,NCH)
711 GSCU=GSCU*GSCZ
712 GSCV=GSCV*GSCZ
713 CALL HPLI
714 CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV)
715 IOPTT = INDEX(NOPT,'T')+INDEX(NOPT,'t')
716 IOPTH = INDEX(NOPT,'H')+INDEX(NOPT,'h')
717 IF(IOPTT.NE.0) CALL GDXYZ(0)
718 IF(IOPTH.NE.0) CALL GDHITS('*','*',0,0,.2)
719*
720 ELSEIF (CHPATL.EQ.'PERSP') THEN
721 CALL KUGETC(NAME,NCH)
722 CALL KUGETR(DISTT)
723 CALL KUGETC(SAMP,NCH)
724 IF(DISTT.LT.100.)DISTT=100.
725 DPERS=DISTT
726 IF(SAMP(1:2).EQ.'ON')THEN
727 IWTY=IGIWTY(1)
728 IF(IWTY.LE.10.AND.IWTY.GE.1)THEN
729 LEP=-ABS(LEP)
730 CALL IGQWK(1,'MXDS',RVAL)
731 IXXX=RVAL(1)
732 IYYY=RVAL(2)
733 DO 120 II=1,1000000
734 CALL IRQLC(1,2,ISTAT,NT,X2,Y2)
735 IF(ISTAT.EQ.0)GOTO 130
736 DPERS=Y2*100.+100.
737 GTHETA=X2*4.5
738 GPHI=90.-GTHETA
739 CALL IGPXMP(IPX,IXXX,IYYY,'O')
740 CALL GDRAW(NAME,GTHETA,GPHI,GPSI,GU0,GV0,GSCU,GSCV)
741 CALL IGPXMP(IPX,0,0,'CDR')
742 120 CONTINUE
743 130 CONTINUE
744 ENDIF
745 ENDIF
746
747 ELSEIF (CHPATL.EQ.'LENS') THEN
748 ZZFV=0.
749 IWTY=IGIWTY(1)
750 IF(IWTY.LE.10.AND.IWTY.GE.1)THEN
751 CALL KUGETI(KNUM)
752 IF(KNUM.EQ.1000)KNUM=MYISEL
753 CALL KUGETC(KSAM,NCH)
754 KLLM=KNUM
755 KLSA=KSAM
756 CALL GDLENS(KLLM,KLSA)
757 ENDIF
758*
759 ELSEIF (CHPATL.EQ.'ZOOM') THEN
760 CONTINUE
761 ZZFV=0.
762 ZFU=2.
763 CALL KUGETR(ZFU)
764 ZFV=ZFU
765 CALL KUGETR(ZFV)
766 ZZFU=ZFU
767 ZZFV=ZFV
768 IF(ZZFU.EQ.0.)ZZFV=0.
769 IF(ZFU.EQ.0.OR.ZFV.EQ.0)GO TO 140
770 IMODE=1
771 CALL KUGETI(IMODE)
772 UZ0=PLTRNX*.5
773 CALL KUGETR(UZ0)
774 VZ0=PLTRNY*.5
775 CALL KUGETR(VZ0)
776 U0 =UZ0
777 CALL KUGETR(U0)
778 V0 =U0
779 CALL KUGETR(V0)
780*
781 IF(IMODE.GT.1000)THEN
782 IWTY=IGIWTY(1)
783 IF(IWTY.LE.10.AND.IWTY.GE.1)THEN
784 ISEL1=IMODE-1000
785 CALL GDXZOO(ISEL1,ZFU,ZFV,UZ0,VZ0,U0,V0)
786 RETURN
787 ENDIF
788 ELSEIF(IMODE.EQ.1000)THEN
789 IWTY=IGIWTY(1)
790 IF(IWTY.LE.10.AND.IWTY.GE.1)THEN
791 ISEL1=MYISEL
792 CALL GDXZOO(ISEL1,ZFU,ZFV,UZ0,VZ0,U0,V0)
793 RETURN
794 ENDIF
795 ENDIF
796*
797 IF(IMODE.EQ.0)THEN
798*
799 CALL GDCURS(UZ0,VZ0,JCHAR)
800 IF (JCHAR.EQ.0) GO TO 999
801*
802 ELSE IF(IMODE.EQ.1)THEN
803*
804 CALL IGLOC2(1,NT,UZ1,VZ1,UZ2,VZ2,ISTAT,'R')
805 IF (ISTAT.EQ.0) GO TO 999
806 IF (UZ2-UZ1.EQ.0.) UZ2=UZ1+PLTRNX/200.
807 IF (VZ2-VZ1.EQ.0.) VZ2=VZ1+PLTRNY/200.
808 ZFU=PLTRNX/ABS(UZ2-UZ1)
809 ZFV=PLTRNY/ABS(VZ2-VZ1)
810 UZ0=(UZ1+UZ2)/2.
811 VZ0=(VZ1+VZ2)/2.
812*
813 ELSE IF(IMODE.EQ.2)THEN
814*
815 CALL GDCURS(UZ0,VZ0,JCHAR)
816 IF (JCHAR.EQ.0) GO TO 999
817 CALL GDCURS(U0,V0,JCHAR)
818 IF (JCHAR.EQ.0) GO TO 999
819*
820 ENDIF
821*
822 140 CALL GDZOOM(ZFU,ZFV,UZ0,VZ0,U0,V0)
823*
824*
825 ELSEIF (CHPATL.EQ.'DXYZ') THEN
826 CALL KUGETI(IT)
827 CALL GDXYZ(IT)
828*
829 ELSEIF (CHPATL.EQ.'KXYZ') THEN
830 CALL KUGETR(EPSXYZ)
831 CALL GKXYZ(EPSXYZ)
832*
833 ELSEIF (CHPATL.EQ.'DPART') THEN
834 CALL KUGETI(IT)
835 ISELP = 11
836 CALL KUGETI(ISELP)
837 CALL KUGETR(SIZE)
838 CALL GDPART(IT,ISELP,SIZE)
839*
840 ELSEIF (CHPATL.EQ.'DHITS') THEN
841 CALL KUGETC(IVS,NCH)
842 CALL KUGETC(ICS,NCH)
843 CALL KUGETI(IUTR)
844 ISYMB=0
845 CALL KUGETI(ISYMB)
846 CALL KUGETR(SSYMB)
847 CALL GDHITS(IVS,ICS,IUTR,ISYMB,SSYMB)
848*
849 ELSEIF (CHPATL.EQ.'KHITS') THEN
850 CALL KUGETC(IVS,NCH)
851 CALL KUGETC(ICS,NCH)
852 CALL KUGETR(EPSHIT)
853 CALL GKHITS (IVS,ICS,EPSHIT)
854*
855 ELSEIF (CHPATL.EQ.'DCHIT') THEN
856 IUTR =0
857 ISYMB=0
858 SIZMAX=1.
859 KDHIT =4
860 HITMIN=0.
861 HITMAX=0.
862 CALL KUGETC(IVS,NCH)
863 CALL KUGETC(ICS,NCH)
864 CALL KUGETI(IUTR)
865 CALL KUGETI(ISYMB)
866 CALL KUGETR(SIZMAX)
867 CALL KUGETI(KDHIT)
868 CALL KUGETR(HITMIN)
869 CALL KUGETR(HITMAX)
870 CALL GDCHIT(IVS,ICS,IUTR,ISYMB,SIZMAX,KDHIT, HITMIN,HITMAX)
871*
872 ELSEIF (CHPATL.EQ.'DUVIEW') THEN
873 CALL KUGETC(IDS,NCH)
874 CALL KUGETC(IVS,NCH)
875 CALL KUGETC(ICS,NCH)
876 CALL KUGETI(IVIEW)
877#if !defined(CERNLIB_USRJMP)
878 CALL GUVIEW(IDS,IVS,ICS,IVIEW)
879#endif
880#if defined(CERNLIB_USRJMP)
881 CALL JUMPT4(JUVIEW,IDS,IVS,ICS,IVIEW)
882#endif
883 ENDIF
884*
885 999 END