GEANT321/gdraw/gdspec.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:03  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.3  1996/10/01 14:12:05  ravndal
   9 * right units for SPHE specs.
  10 *
  11 * Revision 1.2  1996/09/30 14:54:13  ravndal
  12 * Right units for the spec of PARA
  13 *
  14 * Revision 1.1.1.1  1995/10/24 10:20:28  cernlib
  15 * Geant
  16 *
  17 *
  18 #include "geant321/pilot.h"
  19 *CMZ :  3.21/02 20/07/94  18.08.26  by  S.Ravndal
  20 *-- Author :
  21       SUBROUTINE GDSPEC(NAME)
  22 C.
  23 C.    ******************************************************************
  24 C.    *                                                                *
  25 C.    *       This routine draws specifications of volume NAME         *
  26 C.    *                                                                *
  27 C.    *    ==>Called by : <USER>, <GXINT>, GDFSPC                      *
  28 C.    *       Authors : P.Zanarini   *********                         *
  29 C.    *                 A.McPherson  *****                             *
  30 C.    *                                                                *
  31 C.    ******************************************************************
  32 C.
  33 #include "geant321/gcbank.inc"
  34 #include "geant321/gcdraw.inc"
  35 #include "geant321/gcnum.inc"
  36 #include "geant321/gcshno.inc"
  37       CHARACTER*4 ICTUB(11)
  38       CHARACTER*4 NAME,NAMSEE,ISON
  39       CHARACTER*4 IBOX(5),ITRD1(5),ITUBE(5),ITUBS(5)
  40       CHARACTER*4 ITRD2(6),ICON(5),ICONS(7),ISPH(6),ITRAP(11),IPARA(6),
  41      +IPGON(7),IPCON(6),IGTRA(12),IHYPE(4),IELTU(3)
  42       DIMENSION PAR(100),IPAR(12),IPA(3),ISPAR(3)
  43       DIMENSION U0(3),V0(3),THE(3),PHI(3),ISHT(2)
  44       DIMENSION U01(3),V01(3)
  45       DIMENSION NNDM(100),INDM(5,100),ATT(10)
  46       CHARACTER*12 CHTEXT
  47       SAVE IBOX,ITRD1,ITRD2,ITRAP,ITUBE,ITUBS,ICON,ICONS,ISPH,IPARA
  48       SAVE IPGON,IPCON,IGTRA,ICTUB,IHYPE,IELTU
  49       SAVE NNDM,INDM,U01,V01,THE,PHI,XMAN1,YMAN1
  50 C
  51       DATA IBOX /'DX  ','DY  ','DZ  ','    ','    '/
  52       DATA ITRD1/'DX1 ','DX2 ','DY  ','DZ  ','    '/
  53       DATA ITRD2/'DX1 ','DX2 ','DY1 ','DY2 ','DZ  ','    '/
  54       DATA ITRAP/'DZ  ','THET','PHI ','H1  ','BL1 ','TL1 ','ALP1',
  55      +'H2  ','BL2 ','TL2 ','ALP2'/
  56       DATA ITUBE/'RMIN','RMAX','DZ  ','    ','    '/
  57       DATA ITUBS/'RMIN','RMAX','DZ  ','PHI1','PHI2'/
  58       DATA ICON /'DZ  ','RMN1','RMX1','RMN2','RMX2'/
  59       DATA ICONS/'DZ  ','RMN1','RMX1','RMN2','RMX2','PHI1','PHI2'/
  60       DATA ISPH /'RMIN','RMAX','THE1','THE2','PHI1','PHI2'/
  61       DATA IPARA/'DX  ','DY  ','DZ  ','ALPH','THET','PHI '/
  62       DATA IPGON/'PHI1','DPHI','NPDV','NZ  ','Z   ','RMIN','RMAX'/
  63       DATA IPCON/'PHI1','DPHI','NZ  ','Z   ','RMIN','RMAX'/
  64       DATA IHYPE/'RMIN','RMAX','DZ  ','TWST'/
  65       DATA IGTRA/'DZ  ','THET','PHI ','TWIS','H1  ','BL1 ','TL1 ',
  66      +'ALP1','H2  ','BL2 ','TL2 ','ALP2'/
  67       DATA ICTUB/'RMIN','RMAX','DZ  ','PHI1','PHI2','LXL ','LYL ',
  68      +           'LZL ','LXH ','LYH ','LZH '/
  69       DATA IELTU /'A   ','B   ','DZ  '/
  70 C
  71       DATA NNDM/0,0,0,4,0,2,0,2,4,3,4,3,0,0,13*0,5,72*0/
  72       DATA INDM/0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0, 2,3,7,11,0, 0,0,0,0,0,
  73      +          4,5,0,0,0, 0,0,0,0,0, 6,7,0,0,0, 3,4,5,6,0, 4,5,6,0,0,
  74      +          1,2,3,4,0, 1,2,3,0,0, 0,0,0,0,0, 70*0, 2,3,4,8,12,
  75      +          360*0/
  76 C
  77       DATA U01/14.5,5.5,14.5/
  78       DATA V01/14.,5.,5./
  79       DATA THE/45.,0.,90./
  80       DATA PHI/135.,0.,180./
  81       DATA XMAN1/8.8/
  82       DATA YMAN1/11.6/
  83 C.
  84 C.    ------------------------------------------------------------------
  85 C.
  86 C             Is NAME an existing volume ?
  87 C
  88 ***      CALL IGRNG(20.,20.)
  89       CALL HPLFRA(0.,20.,0.,20.,'AB')
  90       CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
  91       IF (IVO.LE.0) GO TO 999
  92 C
  93 C             Normalize to PLTRNX,PLTRNY
  94 C
  95       DO 10 I=1,3
  96          U0(I)=U01(I)*PLTRNX/20.
  97          V0(I)=V01(I)*PLTRNY/20.
  98    10 CONTINUE
  99       XMAN=XMAN1*PLTRNX/20.
 100       YMAN=YMAN1*PLTRNY/20.
 101 C
 102 C             Save GDRAW calling parameters
 103 C             and ZOOM internal parameters
 104 C
 105       SAVTHE=GTHETA
 106       SAVPHI=GPHI
 107       SAVPSI=GPSI
 108       SAVU0=GU0
 109       SAVV0=GV0
 110       SAVSCU=GSCU
 111       SAVSCV=GSCV
 112       SVGZUA=GZUA
 113       SVGZVA=GZVA
 114       SVGZUB=GZUB
 115       SVGZVB=GZVB
 116       SVGZUC=GZUC
 117       SVGZVC=GZVC
 118       GZUA=1
 119       GZVA=1
 120       GZUB=0
 121       GZVB=0
 122       GZUC=0
 123       GZVC=0
 124 C
 125 C             Get shape type
 126 C
 127       JVO=LQ(JVOLUM-IVO)
 128       ISHAPE=Q(JVO+2)
 129 C
 130 C             Get user parameters
 131 C
 132       CALL GFPARA(NAME,1,0,NPAR,NATT,PAR,ATT)
 133       IF(NPAR.LE.0) GO TO 250
 134 C
 135 C
 136 C             Check parameter sizes
 137 C
 138       PARMAX=-1.
 139       DO 40 I=1,NPAR
 140          IF(NNDM(ISHAPE).LE.0) GO TO 30
 141          NDM=NNDM(ISHAPE)
 142          DO 20 IDM=1,NDM
 143             IF(I.EQ.INDM(IDM,ISHAPE)) GO TO 40
 144    20    CONTINUE
 145    30    ABSPAR=ABS(PAR(I))
 146          PARMAX=MAX(PARMAX,ABSPAR)
 147    40 CONTINUE
 148 C
 149       GSCU=MIN(PLTRNX,PLTRNY)/(7.*PARMAX)
 150       GSCV=GSCU
 151       AXSIZ=PARMAX*0.35
 152 C
 153 C             Draw header
 154 C
 155       CALL GDHEAD(-1,NAME,0.)
 156 C
 157 C             Draw parameters list
 158 C
 159       DY=0.4
 160       IF(NPAR.GT.20) NPAR=20
 161       IF(NPAR.GT.10) DY=5.0/NPAR
 162       H=DY*0.7
 163 C
 164       DO 210 I=1,NPAR
 165          CALL UCTOH(' = <',ISPAR(2),4,4)
 166          CALL UCTOH('CM $',ISPAR(3),4,4)
 167          IF (ISHAPE.NE.1) GO TO 50
 168          CALL UCTOH('B<OX',ISHT(1),4,4)
 169          CALL UCTOH('   $',ISHT(2),4,4)
 170          CALL UCTOH(IBOX(I),ISPAR(1),4,4)
 171          GO TO 200
 172    50    IF (ISHAPE.NE.2) GO TO 60
 173          CALL UCTOH('T<RD',ISHT(1),4,4)
 174          CALL UCTOH('>1 $',ISHT(2),4,4)
 175          CALL UCTOH(ITRD1(I),ISPAR(1),4,4)
 176          GO TO 200
 177    60    IF(ISHAPE.NE.3) GO TO 70
 178          CALL UCTOH('T<RD',ISHT(1),4,4)
 179          CALL UCTOH('>2 $',ISHT(2),4,4)
 180          CALL UCTOH(ITRD2(I),ISPAR(1),4,4)
 181          GO TO 200
 182    70    IF(ISHAPE.NE.4) GO TO 80
 183          CALL UCTOH('T<RA',ISHT(1),4,4)
 184          CALL UCTOH('P  $',ISHT(2),4,4)
 185          CALL UCTOH(ITRAP(I),ISPAR(1),4,4)
 186          IF(I.EQ.2.OR.I.EQ.3.OR.I.EQ.7.OR.I.EQ.11)THEN
 187             CALL UCTOH(' = <',ISPAR(2),4,4)
 188             CALL UCTOH('DEG$',ISPAR(3),4,4)
 189          ENDIF
 190          GO TO 200
 191    80    IF (ISHAPE.NE.5) GO TO 90
 192          CALL UCTOH('T<UB',ISHT(1),4,4)
 193          CALL UCTOH('E  $',ISHT(2),4,4)
 194          CALL UCTOH(ITUBE(I),ISPAR(1),4,4)
 195          GO TO 200
 196    90    IF (ISHAPE.NE.6) GO TO 100
 197          CALL UCTOH('T<UB',ISHT(1),4,4)
 198          CALL UCTOH('S  $',ISHT(2),4,4)
 199          CALL UCTOH(ITUBS(I),ISPAR(1),4,4)
 200          IF(I.GT.3)THEN
 201             CALL UCTOH(' = <',ISPAR(2),4,4)
 202             CALL UCTOH('DEG$',ISPAR(3),4,4)
 203          ENDIF
 204          GO TO 200
 205   100    IF(ISHAPE.NE.7) GO TO 110
 206          CALL UCTOH('C<ON',ISHT(1),4,4)
 207          CALL UCTOH('E  $',ISHT(2),4,4)
 208          CALL UCTOH(ICON(I),ISPAR(1),4,4)
 209          GO TO 200
 210   110    IF(ISHAPE.NE.8) GO TO 120
 211          CALL UCTOH('C<ON',ISHT(1),4,4)
 212          CALL UCTOH('S  $',ISHT(2),4,4)
 213          CALL UCTOH(ICONS(I),ISPAR(1),4,4)
 214          IF(I.GT.5)THEN
 215             CALL UCTOH(' = <',ISPAR(2),4,4)
 216             CALL UCTOH('DEG$',ISPAR(3),4,4)
 217          ENDIF
 218          GO TO 200
 219   120    IF(ISHAPE.NE.9) GO TO 130
 220          CALL UCTOH('S<PH',ISHT(1),4,4)
 221          CALL UCTOH('E  $',ISHT(2),4,4)
 222          CALL UCTOH(ISPH(I),ISPAR(1),4,4)
 223          IF(I.GT.2)THEN
 224             CALL UCTOH(' = <',ISPAR(2),4,4)
 225             CALL UCTOH('DEG$',ISPAR(3),4,4)
 226          ENDIF
 227          GO TO 200
 228   130    IF(ISHAPE.NE.10) GO TO 140
 229          CALL UCTOH('P<AR',ISHT(1),4,4)
 230          CALL UCTOH('A  $',ISHT(2),4,4)
 231          CALL UCTOH(IPARA(I),ISPAR(1),4,4)
 232          IF(I.GT.3)THEN
 233             CALL UCTOH(' = <',ISPAR(2),4,4)
 234             CALL UCTOH('DEG$',ISPAR(3),4,4)
 235          ENDIF
 236          GO TO 200
 237   140    IF(ISHAPE.NE.11.AND.ISHAPE.NE.12) GO TO 170
 238          CALL UCTOH('P<GO',ISHT(1),4,4)
 239          CALL UCTOH('N  $',ISHT(2),4,4)
 240          IU=I
 241          IF(IU.LT.8) GO TO 150
 242          I2=I-5
 243          I3=I2/3
 244          I4=I2-I3*3
 245          IU=I4+5
 246   150    CALL UCTOH(IPGON(IU),ISPAR(1),4,4)
 247          IF(I.LT.3)THEN
 248             CALL UCTOH(' = <',ISPAR(2),4,4)
 249             CALL UCTOH('DEG$',ISPAR(3),4,4)
 250          ENDIF
 251          IF(I.EQ.3.OR.I.EQ.4)CALL UCTOH('   $', ISPAR(3),4,4)
 252          IF(ISHAPE.EQ.11) GO TO 200
 253          CALL UCTOH('P<CO',ISHT(1),4,4)
 254          IU=I
 255          IF(IU.LT.7) GO TO 160
 256          I2=I-4
 257          I3=I2/3
 258          I4=I2-I3*3
 259          IU=I4+4
 260   160    CALL UCTOH(IPCON(IU),ISPAR(1),4,4)
 261          IF(I.EQ.4) CALL UCTOH('CM $',ISPAR(3),4,4)
 262 C
 263          GO TO 200
 264   170    CONTINUE
 265          IF(ISHAPE.NE.13) GO TO 180
 266          CALL UCTOH('E<LT',ISHT(1),4,4)
 267          CALL UCTOH('U  $',ISHT(2),4,4)
 268          CALL UCTOH(IELTU(I),ISPAR(1),4,4)
 269          GO TO 200
 270   180    CONTINUE
 271          IF(ISHAPE .NE. 14) GO TO 190
 272          CALL UCTOH('H<YP',ISHT(1),4,4)
 273          CALL UCTOH('E  $',ISHT(2),4,4)
 274          CALL UCTOH(IHYPE(I),ISPAR(1),4,4)
 275          IF(I .GT. 3) THEN
 276             CALL UCTOH(' = <',ISPAR(2),4,4)
 277             CALL UCTOH('DEG$',ISPAR(3),4,4)
 278          ENDIF
 279          GO TO 200
 280 C
 281   190    CONTINUE
 282 C
 283 C             Cut tube
 284 C
 285          IF (ISHAPE.EQ.NSCTUB) THEN
 286             CALL UCTOH('CT<U',ISHT(1),4,4)
 287             CALL UCTOH('B  $',ISHT(2),4,4)
 288             CALL UCTOH(ICTUB(I),ISPAR(1),4,4)
 289             IF(I.GE.4.AND.I.LE.5)THEN
 290                CALL UCTOH(' = <',ISPAR(2),4,4)
 291                CALL UCTOH('DEG$',ISPAR(3),4,4)
 292             ELSE IF(I.GE.6)THEN
 293                CALL UCTOH(' =  ',ISPAR(2),4,4)
 294                CALL UCTOH('  $ ',ISPAR(3),4,4)
 295             END IF
 296             GO TO 200
 297          ENDIF
 298 C
 299 C             General twisted trapezoid.
 300 C
 301          IF(ISHAPE.NE.28) GO TO 230
 302          CALL UCTOH('G>TR',ISHT(1),4,4)
 303          CALL UCTOH('A  $',ISHT(2),4,4)
 304          CALL UCTOH(IGTRA(I),ISPAR(1),4,4)
 305          IF(I.EQ.2.OR.I.EQ.3.OR.I.EQ.4.OR.I.EQ.8.OR. I.EQ.12) CALL
 306      +   UCTOH('DEG$',ISPAR(3),4,4)
 307 C
 308   200    CONTINUE
 309          IF (I.EQ.1) THEN
 310             XTEXT=4.*PLTRNX/20.
 311             YTEXT=16.5*PLTRNY/20.
 312             CSIZE=DY*MIN(PLTRNX,PLTRNY)/20.
 313             CALL UHTOC(ISHT,4,CHTEXT,12)
 314             CALL GDRAWT(XTEXT,YTEXT,CHTEXT,CSIZE,0.,1,-1)
 315          ENDIF
 316          Y=16.5-(I+0.5)*DY
 317          XTEXT=3.*PLTRNX/20.
 318          YTEXT=Y*PLTRNY/20.
 319          CSIZE=H*MIN(PLTRNX,PLTRNY)/20.
 320          CALL UHTOC(ISPAR,4,CHTEXT,12)
 321          CALL GDRAWT(XTEXT,YTEXT,CHTEXT,CSIZE,0.,1,-1)
 322          CALL HBCDF(PAR(I),8,IPAR)
 323          IF (PAR(I).EQ.0.) CALL UCTOH('0',IPAR(1),1,1)
 324          CALL UCTOH('$',IPAR(9),1,1)
 325          CALL UBUNCH(IPAR,IPA,9)
 326          XTEXT=(H*10.+3.)*PLTRNX/20.
 327          YTEXT=Y*PLTRNY/20.
 328          CSIZE=H*MIN(PLTRNX,PLTRNY)/20.
 329          CALL UHTOC(IPA,4,CHTEXT,12)
 330          CALL GDRAWT(XTEXT,YTEXT,CHTEXT,CSIZE,0.,1,-1)
 331   210 CONTINUE
 332 C
 333 C             Draw views
 334 C
 335       CALL GFATT(NAME,'SEEN',KSEEN)
 336 C
 337 C             Add local value SEEN 1 to starting node of tree
 338 C
 339       KSEEN=KSEEN+110
 340       ISEEN=KSEEN
 341       CALL GSATT(NAME,'SEEN',ISEEN)
 342 C
 343       CALL GSATT(NAME,'COLO',2)
 344       CALL GDNSON(NAME,NSON,IDIV)
 345       DO 220 N=1,NSON
 346          CALL GDSON(N,NAME,ISON)
 347          CALL GFATT(ISON,'SEEN',KSEEN)
 348 C
 349 C             ISON is a volume with multiplicity;
 350 C             first occurrence has already been set
 351 C
 352          IF (KSEEN.GT.50) GO TO 220
 353 C
 354 C             Add local value SEEN -2 to each one-level-down node
 355 C
 356          KSEEN=KSEEN+80
 357          ISEEN=KSEEN
 358          CALL GSATT(ISON,'SEEN',ISEEN)
 359 C
 360          CALL GSATT(ISON,'COLO',4)
 361   220 CONTINUE
 362 C
 363       CALL GDCOL(3)
 364       XSCAL=PLTRNX/4.
 365       YSCAL=PLTRNY/2.
 366       CALL GDSCAL(XSCAL,YSCAL)
 367 **    IF (GSCU.LE.0.05) CALL GDMAN(XMAN,YMAN)
 368       IF (GSCU.LE.0.05) CALL GDWMN1(XMAN,YMAN)
 369 C
 370       CALL GDRAW(NAME,THE(1),PHI(1),0.,U0(1),V0(1),GSCU,GSCV)
 371       CALL GDAXIS(0.,0.,0.,AXSIZ)
 372       CALL GDRAWC(NAME,3,0.005,U0(2),V0(2),GSCU,GSCV)
 373       CALL GDAXIS(0.,0.,0.,AXSIZ)
 374       CALL GDRAWC(NAME,1,0.005,U0(3),V0(3),GSCU,GSCV)
 375       CALL GDAXIS(0.,0.,0.,AXSIZ)
 376 C
 377   230 CALL GDCOL(0)
 378 C
 379 C             Reset global SEEN values
 380 C
 381       DO 240 IVO=1,NVOLUM
 382          CALL UHTOC(IQ(JVOLUM+IVO),4,NAMSEE,4)
 383          CALL GFATT(NAMSEE,'SEEN',KSEEN)
 384          IF (KSEEN.LT.50) GO TO 240
 385          ISEENL=KSEEN/10.+0.5
 386          ISEENG=KSEEN-ISEENL*10.
 387          CALL GSATT(NAMSEE,'SEEN',ISEENG)
 388   240 CONTINUE
 389 C
 390   250 CONTINUE
 391 C
 392 C             Restore GDRAW calling parameters
 393 C             and ZOOM internal parameters
 394 C
 395       GTHETA=SAVTHE
 396       GPHI=SAVPHI
 397       GPSI=SAVPSI
 398       GU0=SAVU0
 399       GV0=SAVV0
 400       GSCU=SAVSCU
 401       GSCV=SAVSCV
 402       NGVIEW=0
 403       GZUA=SVGZUA
 404       GZVA=SVGZVA
 405       GZUB=SVGZUB
 406       GZVB=SVGZVB
 407       GZUC=SVGZUC
 408       GZVC=SVGZVC
 409       CALL ISELNT(1)
 410   999 END