GEANT321/gdraw/gdtree.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:29  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GDTREE(KNAME,LEVMAX,ISEL)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Draw the tree of geometric data structure starting       *
  17 C.    *       from object KNAME, for LEVMAX depth levels (0=all)       *
  18 C.    *                                                                *
  19 C.    *       If ISEL=      0   then draw only node name;              *
  20 C.    *       if ISEL=xxxxxx1   then add multiplicity;                 *
  21 C.    *       if ISEL=xxxxx1x   then add 'ONLY' information;           *
  22 C.    *       if ISEL=xxxx1xx   then add 'DET ' information;           *
  23 C.    *       if ISEL=xxx1xxx   then add 'SEEN' information;           *
  24 C.    *       if ISEL=xx1xxxx   then add little picture of volume;     *
  25 C.    *       if ISEL=x1xxxxx   then add graphics cursor and           *
  26 C.    *                         returns in IPICK the node picked;      *
  27 C.    *                                                                *
  28 C.    *       For very big trees, the attribute SEEN -3 can be applied *
  29 C.    *       to any node in the level that has too many different     *
  30 C.    *       nodes (each with a different volume name) : the routine  *
  31 C.    *       GDTREE will draw only the first, the last, and one       *
  32 C.    *       dummy node in the middle that tells how many nodes       *
  33 C.    *       does it stand for.                                       *
  34 C.    *                                                                *
  35 C.    *    ==>Called by : <USER>, <GXINT>                              *
  36 C.    *       Authors : P.Zanarini ; S.Giani  *********                *
  37 C.    *                                                                *
  38 C.    ******************************************************************
  39 C.
  40 #include "geant321/gcunit.inc"
  41 #include "geant321/gcbank.inc"
  42 #include "geant321/gcnum.inc"
  43 #include "geant321/gcdraw.inc"
  44 #include "geant321/gchil2.inc"
  45 #include "geant321/gccurs.inc"
  46 #include "geant321/gcursb.inc"
  47 *
  48       CHARACTER*4 KNAME,NAME,NAME1,MOTH
  49       DIMENSION U(4),V(4),UUU(15),VVV(15),SVVX(3),SVVY(3)
  50       SAVE SAVTHE,SAVPHI,SAVU0,SAVV0,SAVSCU,SAVSCV,SVGZUA,SVGZVA
  51       SAVE SVGZUB,SVGZVB,SVGZUC,SVGZVC
  52       COMMON/NPILEV/NPILE
  53
  54 C.
  55 C.    ------------------------------------------------------------------
  56 C.
  57 C             Is NAME an existing volume ?
  58 C
  59 *      CALL IGSET('SYNC',1.)
  60       IF (MOMO.EQ.' ') THEN
  61          CALL UHTOC(IQ(JVOLUM+1),4,NAME,4)
  62          MOMO=NAME
  63       ENDIF
  64       IF (KNAME.EQ.' ') THEN
  65          CALL UHTOC(IQ(JVOLUM+1),4,NAME,4)
  66          KNAME=NAME
  67       ELSE
  68          CALL GLOOK(KNAME,IQ(JVOLUM+1),NVOLUM,IVO)
  69          IF (IVO.LE.0) GO TO 180
  70          NAME=KNAME
  71       ENDIF
  72 C
  73 C             Build tree structure using view bank 11
  74 C
  75       IVTREE=NKVIEW+1
  76       CALL UCTOH (NAME, IROOT, 4, 4)
  77       CALL GDTR0 (IVTREE, IROOT, LEVMAX, IER)
  78       IF (IER.NE.0) GO TO 170
  79 C
  80       IPICK=0
  81 C
  82       ISEL5=ISEL/100000
  83       ISEL5=ISEL5-ISEL5/2*2
  84       ISEL4=ISEL/10000
  85       ISEL4=ISEL4-ISEL4/2*2
  86       ISEL3=ISEL/1000
  87       ISEL3=ISEL3-ISEL3/2*2
  88       ISEL2=ISEL/100
  89       ISEL2=ISEL2-ISEL2/2*2
  90       ISEL1=ISEL/10
  91       ISEL1=ISEL1-ISEL1/2*2
  92       ISEL0=ISEL/1
  93       ISEL0=ISEL0-ISEL0/2*2
  94 C
  95 C             Save GDRAW calling parameters
  96 C             and ZOOM internal parameters
  97 C
  98       IDRAW=0
  99       IF (ISEL4.NE.0) THEN
 100          IDRAW=1
 101          SAVTHE=GTHETA
 102          SAVPHI=GPHI
 103          SAVU0=GU0
 104          SAVV0=GV0
 105          SAVSCU=GSCU
 106          SAVSCV=GSCV
 107          SVGZUA=GZUA
 108          SVGZVA=GZVA
 109          SVGZUB=GZUB
 110          SVGZVB=GZVB
 111          SVGZUC=GZUC
 112          SVGZVC=GZVC
 113          GZUA=1
 114          GZVA=1
 115          GZUB=0
 116          GZVB=0
 117          GZUC=0
 118          GZVC=0
 119       ENDIF
 120 C
 121 C             Fill arrays Q(JULEV) and Q(JVLEV)
 122 C
 123       DO 10 I=1,NUMND1
 124          IQ(JSCA1+I)=0
 125    10 CONTINUE
 126 C
 127       MAXV=LEVMAX
 128       LEVVER=1
 129       LEVHOR=0
 130       MLEVV=1
 131       CALL GDTR10(1)
 132       MLEVH=LEVHOR
 133 C
 134       PLTVER=25.
 135       SIZE=PLTVER/(4.*MLEVV)
 136 ***      SIZE=PLTVER/(4.*MLEVV)
 137 C
 138 C             Compute user coordinates boundaries of tree picture
 139 C
 140       SIZ2=SIZE*2.
 141 ***      SIZ4=SIZE*4.
 142       IF(MLEVH.GT.MLEVV)THEN
 143          SIZ4=(MLEVH*SIZ2)/MLEVV
 144          FACHV=(MLEVH/2.)/MLEVV
 145          IF(FACHV.LT.2.)FACHV=1.
 146       ELSE
 147          SIZ4=SIZE*4.
 148          FACHV=1.
 149       ENDIF
 150       SIZD2=SIZE/2.
 151       XPLT=MLEVH*SIZ2
 152       YPLT=MLEVV*SIZ4
 153 C
 154 C             Save current ranges and store new ones
 155 C
 156       SAVPLX=PLTRNX
 157       SAVPLY=PLTRNY
 158 C
 159       PLTRNX=YPLT
 160       PLTRNY=XPLT
 161 C
 162       CALL IGRNG(YPLT,XPLT)
 163 *      CALL IGRNG(XPLT,YPLT)
 164 C
 165 C             Draw nodes
 166 C
 167       IDUP=1
 168       IONL=1
 169       IDET=0
 170       ISEEN=1
 171 *      INTSPI=0
 172       DO 60 J=1,NUMND1
 173          IF (IQ(JSCA1+J).NE.0) THEN
 174             CALL UHTOC(IQ(JNAM1+J),4,NAME,4)
 175             IF(INTFLA.EQ.10)THEN
 176                IADDI=0
 177 *               INTSPI=1
 178                INTFLA=1
 179                CALL MZLINT(IXDIV,'/GCHIL2/',LARETT,JMYMOT,LARETT)
 180                LARETT(1)=1
 181                IF(JTICK.NE.0) CALL MZDROP(IXSTOR, JTICK, ' ')
 182                IF(JMYLL.NE.0) CALL MZDROP(IXSTOR, JMYLL, ' ')
 183                NEE=NUMND1+10
 184                NEES=NEE*2
 185                CALL MZNEED(IXDIV,NEES,'G')
 186                CALL MZBOOK(IXDIV,JTICK,JTICK,1,'TTT',0,0,NEE,2,-1)
 187                CALL MZBOOK(IXDIV,JMYLL,JMYLL,1,'MMM',0,0,NEE,2,-1)
 188                IF(JFIMOT.NE.0) CALL MZDROP(IXSTOR, JFIMOT, ' ')
 189                IF(JFISCA.NE.0) CALL MZDROP(IXSTOR, JFISCA, ' ')
 190                IF(JFINAM.NE.0) CALL MZDROP(IXSTOR, JFINAM, ' ')
 191                NEES=NEE*3
 192                CALL MZNEED(IXDIV,NEES,'G')
 193                CALL MZBOOK(IXDIV,JFIMOT,JFIMOT,1,'FIMO',0,0,NEE,2,-1)
 194                CALL MZBOOK(IXDIV,JFISCA,JFISCA,1,'FISC',0,0,NEE,2,-1)
 195                CALL MZBOOK(IXDIV,JFINAM,JFINAM,1,'FINA',0,0,NEE,2,-1)
 196                NUMND2=NUMND1
 197             ENDIF
 198             IF(INTFLA.EQ.1)THEN
 199                MLETMP=MLEVV
 200                LEVTMP=LEVVER
 201                MLEVV=1
 202                LEVVER=1
 203                CALL GDTR10(J)
 204                IQ(JTICK+J)=MLEVV-1
 205                MLEVV=MLETMP
 206                LEVVER=LEVTMP
 207                IF(J.NE.1)THEN
 208 *               IF(INTSPI.NE.1)THEN
 209 *               NUMNDA=NUMND1
 210 *               NUMND1=NUMNDS
 211 *               DO 89  JI=1,NUMNDS
 212 *                  IQ(JNAM1+JI)=IQ(JAASS3+JI)
 213 *                  IQ(JSCA1+JI)=IQ(JAASS4+JI)
 214 *                  IQ(JMOT1+JI)=IQ(JMYMOT+JI)
 215 *   89          CONTINUE
 216 *               ENDIF
 217                   DO 20  LL=1,16
 218                      CALL GDTR8(NAME,MOTH,IONL)
 219                      IF(MOTH.EQ.KNAME)THEN
 220                         IQ(JMYLL+J)=LL+1+IADDI
 221                         GOTO 30
 222                      ENDIF
 223                      NAME=MOTH
 224    20             CONTINUE
 225    30             CONTINUE
 226 *                  IF(INTSPI.NE.1)NUMND1=NUMNDA
 227                ELSE
 228                   IQ(JMYLL+J)=1+IADDI
 229                ENDIF
 230             ELSE
 231                Q(JULEV+J) = (Q(JULEV+J)-1.)*SIZ2 + SIZE
 232 ***            Q(JVLEV+J) = YPLT - (Q(JVLEV+J)-1.)*SIZ4 - SIZ2
 233                Q(JVLEV+J) = (Q(JVLEV+J)-1.)*SIZ4 + SIZ2
 234                IF (ISEL0.NE.0) IDUP=IQ(JDUP1+J)
 235                IF (ISEL1.NE.0) CALL GDTR8(NAME,MOTH,IONL)
 236                IF (ISEL2.NE.0) THEN
 237                   IDET=0
 238                   KVAL=0
 239                   CALL GFATT(NAME,'DET ',KVAL)
 240                   IF (KVAL.GT.0) IDET=1
 241                ENDIF
 242                IF (ISEL3.NE.0) THEN
 243                   KVAL=1
 244                   CALL GFATT(NAME,'SEEN',KVAL)
 245                   IF (KVAL.EQ.1.OR.KVAL.EQ.-2) THEN
 246                      ISEEN=1
 247                   ELSE
 248                      ISEEN=0
 249                   ENDIF
 250                   IF (J.EQ.1) GO TO 50
 251                   JM=J
 252    40             CONTINUE
 253                   JM=IQ(JMOT1+JM)
 254                   KVALM=1
 255                   CALL UHTOC(IQ(JNAM1+JM),4,NAME1,4)
 256                   CALL GFATT(NAME1,'SEEN',KVALM)
 257                   IF (KVALM.LT.0) THEN
 258                      ISEEN=0
 259                      GO TO 50
 260                   ENDIF
 261                   IF (JM.NE.1) GO TO 40
 262    50             CONTINUE
 263                ENDIF
 264 *****            CALL GDPRTR(NAME,Q(JVLEV+J),Q(JULEV+J),SIZE,IDUP,IDRAW,
 265 *****     +      IONL, IDET,ISEEN)
 266                NPILE=IQ(JMYLL+J)
 267                CALL GDPRTR(NAME,Q(JULEV+J),Q(JVLEV+J),SIZE,FACHV,IDUP,
 268      +         IDRAW, IONL, IDET,ISEEN)
 269             ENDIF
 270          ENDIF
 271    60 CONTINUE
 272 C
 273 C             Draw links
 274 C
 275       IF(INTFLA.EQ.1)GOTO 160
 276       LINCOL=1
 277       CALL MVBITS(LINCOL,0,8,LINATT,16)
 278       IF (IQ(JMOT1+1).NE.0) THEN
 279          U(2)=Q(JULEV+1)
 280          U(1)=U(2)
 281          V(2)=Q(JVLEV+1)-(SIZD2*2.*FACHV)
 282          V(1)=V(2)-(SIZE*2.*FACHV)
 283          CALL GDRAWV(V,U,2)
 284 ***         CALL GDRAWV(U,V,2)
 285       ENDIF
 286 C
 287       IGREEN=1
 288       DO 150 J=1,NUMND1
 289          IF (IQ(JSCA1+J).EQ.1) THEN
 290             JX=IQ(JXON1+J)
 291    70       IF (JX.EQ.0) GO TO 120
 292 *            U(1)=Q(JULEV+J)
 293 *            U(2)=Q(JULEV+JX)
 294 *            V(1)=Q(JVLEV+J)+(SIZD2*2.*FACHV)
 295 *            V(2)=Q(JVLEV+JX)-(SIZD2*2.*FACHV)
 296             U(1)=Q(JULEV+J)
 297             U(2)=U(1)
 298             U(3)=Q(JULEV+JX)
 299             U(4)=Q(JULEV+JX)
 300             V(1)=Q(JVLEV+J)+(SIZD2*2.*FACHV)
 301             V(4)=Q(JVLEV+JX)-(SIZD2*2.*FACHV)
 302             V(2)=(V(1)+V(4))/2.
 303             V(3)=V(2)
 304             IF(J.EQ.1)HALF=V(4)-V(3)
 305             IF(NNPAR.EQ.3)THEN
 306                CALL IGPID(1,' ',J,' ')
 307             ENDIF
 308             CALL GDRAWV(V,U,4)
 309 ***
 310            IF(INTFLA.EQ.-1)THEN
 311             ARROWS=(SIZD2*2.*FACHV)/10.
 312             NPO=IQ(JTICK+J)
 313             FRA=(V(2)-V(1))/NPO
 314             DO 80  KJI=1,NPO
 315                VVV(KJI)=V(1)-(FRA/2.)+(FRA*KJI)
 316                UUU(KJI)=U(1)
 317    80       CONTINUE
 318             CALL ISFACI(2)
 319             CALL ISFAIS(1)
 320             DO 90  KJI=1,NPO
 321                SVVX(1)=VVV(KJI)-ARROWS
 322                SVVX(2)=VVV(KJI)-ARROWS
 323                SVVX(3)=VVV(KJI)+ARROWS
 324                SVVY(1)=UUU(KJI)+ARROWS
 325                SVVY(2)=UUU(KJI)-ARROWS
 326                SVVY(3)=UUU(KJI)
 327                IF(NNPAR.EQ.3)THEN
 328                   CALL IGPID(1,'Tree',IQ(JNAM1+J),' ')
 329                   CALL IGPID(2,'Arrow',KJI+1,' ')
 330                ENDIF
 331                CALL IFA(3,SVVX,SVVY)
 332    90       CONTINUE
 333 ***            CALL GDRAWV(U,V,2)
 334             NPO=IQ(JMYLL+J)
 335             FRA=(V(4)-V(3))/NPO
 336             DO 100 KJI=1,NPO
 337                VVV(KJI)=V(3)-(FRA/2.)+(FRA*KJI)
 338                UUU(KJI)=U(3)
 339   100       CONTINUE
 340             CALL ISFACI(3)
 341             CALL ISFAIS(1)
 342             IGREEN=IGREEN+1
 343             IORGO=0
 344             DO 110 KJI=NPO,1,-1
 345                IORGO=IORGO+1
 346                SVVX(1)=VVV(KJI)+ARROWS
 347                SVVX(2)=VVV(KJI)+ARROWS
 348                SVVX(3)=VVV(KJI)-ARROWS
 349                SVVY(1)=UUU(KJI)+ARROWS
 350                SVVY(2)=UUU(KJI)-ARROWS
 351                SVVY(3)=UUU(KJI)
 352                IF(NNPAR.EQ.3)THEN
 353                   CALL IGPID(1,'Tree',IQ(JNAM1+IGREEN),' ')
 354                   CALL IGPID(2,'Arrow',-IORGO,' ')
 355                ENDIF
 356                CALL IFA(3,SVVX,SVVY)
 357   110       CONTINUE
 358            ENDIF
 359 ***
 360             JX=IQ(JBRO1+JX)
 361             GO TO 70
 362   120       CONTINUE
 363          ELSE IF (IQ(JSCA1+J).EQ.-1) THEN
 364            IF(INTFLA.EQ.-1)THEN
 365             ARROWS=(SIZD2*2.*FACHV)/10.
 366             U(1)=Q(JULEV+J)
 367             U(2)=U(1)
 368             V(1)=Q(JVLEV+J)+(SIZD2*2.*FACHV)
 369             V(2)=V(1)+(SIZE*2.*FACHV)
 370             CALL GDRAWV(V,U,2)
 371             NPO=IQ(JTICK+J)
 372             FRA=(V(2)-V(1))/(NPO*2.)
 373             DO 130 KJI=1,NPO
 374                VVV(KJI)=V(1)-(FRA/2.)+(FRA*KJI)
 375                UUU(KJI)=U(1)
 376   130       CONTINUE
 377             CALL ISFACI(2)
 378             CALL ISFAIS(1)
 379             DO 140 KJI=1,NPO
 380                SVVX(1)=VVV(KJI)-ARROWS
 381                SVVX(2)=VVV(KJI)-ARROWS
 382                SVVX(3)=VVV(KJI)+ARROWS
 383                SVVY(1)=UUU(KJI)+ARROWS
 384                SVVY(2)=UUU(KJI)-ARROWS
 385                SVVY(3)=UUU(KJI)
 386                IF(NNPAR.EQ.3)THEN
 387                   CALL IGPID(1,'Tree',IQ(JNAM1+J),' ')
 388                   CALL IGPID(2,'Arrow',KJI+1,' ')
 389                ENDIF
 390                CALL IFA(3,SVVX,SVVY)
 391   140       CONTINUE
 392 ***            CALL GDRAWV(U,V,2)
 393            ENDIF
 394          ENDIF
 395   150 CONTINUE
 396 C
 397 C             Restore GDRAW calling parameters
 398 C             and ZOOM internal parameters
 399 C
 400   160 CONTINUE
 401       IF (ISEL4.NE.0) THEN
 402          GTHETA=SAVTHE
 403          GPHI=SAVPHI
 404          GU0=SAVU0
 405          GV0=SAVV0
 406          GSCU=SAVSCU
 407          GSCV=SAVSCV
 408          NGVIEW=0
 409          GZUA=SVGZUA
 410          GZVA=SVGZVA
 411          GZUB=SVGZUB
 412          GZVB=SVGZVB
 413          GZUC=SVGZUC
 414          GZVC=SVGZVC
 415       ENDIF
 416 C
 417 C             Restore original ranges previously saved
 418 C
 419       PLTRNX=SAVPLX
 420       PLTRNY=SAVPLY
 421 C
 422 ************      CALL IGRNG(PLTRNX,PLTRNY)
 423 C
 424 C             Delete tree structure on view bank 11
 425 C
 426   170 CALL GDTR99(IVTREE)
 427       GO TO 999
 428 C
 429   180 WRITE(CHMAIL,10000)KNAME
 430       CALL GMAIL(0,0)
 431 10000 FORMAT(' GDTREE: VOLUME ',A4,' DOES NOT EXIST')
 432 C
 433   999 END