This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gxint / gxdraw.F
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
13 C.
14 C.    ******************************************************************
15 C.    *                                                                *
16 C.    *      Drawing commands                                          *
17 C.    *                                                                *
18 C.    *       Authors:   R.Brun      **********                        *
19 C.    *                  P.Zanarini  **********                        *
20 C.    *                  S.Giani     **********                        *
21 C.    *                                                                *
22 C.    ******************************************************************
23 C.
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
55 C.
56 C.    ------------------------------------------------------------------
57 C.
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)
69 10000      FORMAT(' *** GXDRAW ***:',
70      +            ' No more space to store MCVOL information.')
71             CALL GMAIL(0,0)
72             WRITE(CHMAIL, 10100)
73 10100      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)
87 10200       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)
369 10300      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