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