[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdprtr.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:23  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/04 10/01/95  16.43.07  by  S.Giani
*-- Author :
      SUBROUTINE GDPRTR(NAME,YLEV,XLEV,SIZE,FACHV,
     +IDUP,IDRAW,IONL,IDET,ISEEN)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       Draws a box centered in (XLEV,YLEV) of size SIZE.        *
C.    *       On the top half box draws its name NAME and, if IDUP<>1, *
C.    *       on the bottom half draw IDUP preceded by a symbol        *
C.    *       (IDUP<0 means division, IDUP>1 means multiple position,  *
C.    *       IDUP=1 means single position).                           *
C.    *       If IDRAW=1 then over the box draws a normal-view of      *
C.    *       volume NAME (with same seen attributes set by GDSPEC).   *
C.    *       If IONL<>1 then draw two other boxes, slightly shifted,  *
C.    *       behind the original one.                                 *
C.    *       If IDET=1 then draw another box, slightly larger,        *
C.    *       around the original one.                                 *
C.    *       If ISEEN=0 then draw the box(es) with dashed lines.      *
C.    *                                                                *
C.    *    ==>Called by : GDTREE                                       *
C.    *       Author : P.Zanarini ; S.Giani  *********                 *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcdraw.inc"
      DIMENSION X(5),Y(5)
      DIMENSION NAMT0(16),NAM0(4)
      DIMENSION PAR(50)
      DIMENSION NNDM(14),INDM(4,14)
      DIMENSION ATT(10)
      CHARACTER*4 NAME,NAMSEE,ISON
      CHARACTER*14 CHNAM0
      SAVE NNDM,INDM
      COMMON/NPILEV/NPILE
C
      DATA NNDM/0,0,0,4,0,2,0,2,4,3,4,3,0,0/
      DATA INDM/0,0,0,0, 0,0,0,0, 0,0,0,0, 2,3,7,11, 0,0,0,0,
     +          4,5,0,0, 0,0,0,0, 6,7,0,0, 3,4,5,6, 4,5,6,0,
     +          1,2,3,4, 1,2,3,0, 0,0,0,0, 0,0,0,0/
C.
C.    ------------------------------------------------------------------
C.
      IF (ISEEN.EQ.0) THEN
         LINSTY=4
      ELSE
         LINSTY=1
      ENDIF
      CALL MVBITS(LINSTY,0,3,LINATT,10)
C
C            Compute box vertex
C
      SIZ2=SIZE/2.
      SIZ4=SIZE/4.
      SIZ8=SIZE/8.
***      X(1)=XLEV-SIZ2
      X(1)=XLEV-(SIZ2*2.*FACHV)
      X(2)=X(1)
***      X(3)=XLEV+SIZ2
      X(3)=XLEV+(SIZ2*2.*FACHV)
      X(4)=X(3)
      X(5)=X(1)
      Y(1)=YLEV+SIZ2
      Y(2)=YLEV-SIZ2
      Y(3)=Y(2)
      Y(4)=Y(1)
      Y(5)=Y(1)
C
C            Draw box
C
      IWTY=IGIWTY(1)
      CALL IGQWK(0,'HWCO',R)
      IF(IWTY.GT.10.OR.IWTY.LT.1.OR.R.EQ.2.)THEN
         LINCOL=1
         CALL MVBITS(LINCOL,0,8,LINATT,16)
         CALL GDRAWV(X,Y,5)
      ELSE
         CALL IGSET('LWID',1.)
         CALL UCTOH(NAME,IIIN,4,4)
         CALL IGPID(1,'Tree',IIIN,' ')
         CALL IGPAVE(X(1),X(3),Y(1),Y(3),SIZ8,1004,1001,'TRS')
      ENDIF
C
C            If volume is also detector draw another box outside
C
      IF (IDET.EQ.1) THEN
         X(1)=X(1)-SIZ8
         X(2)=X(2)-SIZ8
         X(3)=X(3)+SIZ8
         X(4)=X(4)+SIZ8
         X(5)=X(5)-SIZ8
         Y(1)=Y(1)+SIZ8
         Y(2)=Y(2)-SIZ8
         Y(3)=Y(3)-SIZ8
         Y(4)=Y(4)+SIZ8
         Y(5)=Y(5)+SIZ8
         LINCOL=1
         CALL MVBITS(LINCOL,0,8,LINATT,16)
         CALL GDRAWV(X,Y,5)
      ENDIF
C
C            If volume is not 'ONLY' draw two other boxes behind
C
      IF (IONL.NE.1) THEN
         X(1)=XLEV+(SIZ2*2.*FACHV)-SIZ8
         Y(1)=YLEV+SIZ2
         X(2)=X(1)
         Y(2)=Y(1)+SIZ8
         X(3)=X(2)-(SIZE*2.*FACHV)
         Y(3)=Y(2)
         X(4)=X(3)
         Y(4)=Y(3)-SIZE
         X(5)=X(4)+SIZ8
         Y(5)=Y(4)
         LINCOL=1
         CALL MVBITS(LINCOL,0,8,LINATT,16)
         CALL GDRAWV(X,Y,5)
         DO 10 I=1,5
            X(I)=X(I)-SIZ8
            Y(I)=Y(I)+SIZ8
   10    CONTINUE
         CALL GDRAWV(X,Y,5)
      ENDIF
C
      LINSTY=1
      CALL MVBITS(LINSTY,0,3,LINATT,10)
C
C            Draw name
C
      YL=YLEV-SIZ2+(SIZ8/2.)
      IF(FACHV.EQ.1.)YL=YLEV-SIZ8
      XL=XLEV-(SIZ4*FACHV)+SIZ8
      IF(FACHV.EQ.1.)XL=XLEV
      SZ=1.5*SIZ4*2.
      IF(FACHV.EQ.1.)SZ=1.*SIZ4*2.
      ITXCOL=5
      CALL MVBITS(ITXCOL,0,4,ITXATT,3)
      AITXCO=ITXCOL
      CALL IGSET('TXCI',AITXCO)
      CALL IGSET('TXFP',-60.)
      IWTY=IGIWTY(1)
      IF(IWTY.GT.10.OR.IWTY.LT.1)CALL IGSET('TXFP',-61.)
***      CALL IGPID(1,'Tree',NPILE,' ')
      CALL GDRAWT(XL,YL,NAME,SZ,0.,4,0)
      CALL IGSET('TXFP',2.)
      CALL IGSET('TXCI',1.)
C
      IF (IDUP.EQ.1) GO TO 20
C
C            Draw IDUP in bottom half box
C
      CALL UCTOH('<"4#>',NAMT0(1),1,5)
      IF (IDUP.LT.0) CALL UCTOH('F',NAMT0(3),1,1)
      DUP=FLOAT(IABS(IDUP))
      CALL HBCDF(DUP,8,NAMT0(6))
      CALL UCTOH('$',NAMT0(14),1,1)
      CALL UBUNCH(NAMT0,NAM0,14)
      CALL UHTOC(NAM0,4,CHNAM0,14)
      XL=XLEV+(SIZ4*FACHV)+SIZ2
      IF(FACHV.EQ.1.)XL=XLEV-(3.*SIZ8)
      YL=YLEV-SIZ4-SIZ8
      IF(FACHV.EQ.1.)YL=YLEV-SIZ2+(SIZ8/2.)
      SZ=0.7*SIZ4*2.
      IF(FACHV.EQ.1.)SZ=0.7*SIZ4*1.5
      ITXCOL=5
      CALL MVBITS(ITXCOL,0,4,ITXATT,3)
      AITXCO=ITXCOL
      CALL IGSET('TXCI',AITXCO)
      CALL IGSET('TXFP',2.)
***      CALL IGPID(1,'Tree',NPILE,' ')
      CALL GDRAWT(XL,YL,CHNAM0,SZ,0.,10,-1)
      CALL IGSET('TXCI',1.)
C
   20 CONTINUE
C
      IF (IDRAW.NE.1) GO TO 999
C
C             Draw a normal view of the volume
C
      CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
      IF(IVO.LE.0) GO TO 999
C
      JVO=LQ(JVOLUM-IVO)
C
C                GET PARAMETERS
C
      CALL GFPARA(NAME,1,0,NPAR,NATT,PAR,ATT)
      IF(NPAR.LE.0) GO TO 999
C
      ISHAPE=Q(JVO+2)
C
C             CHECK parametER SIZES
C
      PARMAX=-1.
      DO 50  I=1,NPAR
         IF(ISHAPE.GT.14)GO TO 50
         IF(NNDM(ISHAPE).LE.0) GO TO 40
C
         NDM=NNDM(ISHAPE)
         DO 30  IDM=1,NDM
C
            IF(I.EQ.INDM(IDM,ISHAPE)) GO TO 50
C
   30    CONTINUE
   40    CONTINUE
C
         ABSPAR=ABS(PAR(I))
         PARMAX=MAX(PARMAX,ABSPAR)
   50 CONTINUE
      XSCALE=SIZE/(3.*PARMAX)
      YSCALE=XSCALE
      XPOS=XLEV-(SIZE*FACHV*2)+SIZ8
      YPOS=YLEV
*      YPOS=YLEV+SIZE
C
      CALL GFATT(NAME,'SEEN',KSEEN)
C
C             Add local value KSEEN 1 to starting node of tree
C
      KSEEN=KSEEN+110
      ISEEN=KSEEN
      CALL GSATT(NAME,'SEEN',ISEEN)
C
      CALL GDNSON(NAME,NSON,IDIV)
      DO 60  N=1,NSON
         CALL GDSON(N,NAME,ISON)
         CALL GFATT(ISON,'SEEN',KSEEN)
C
C             ISON is a volume with multeplicity;
C             first occurrence has already been set
C
         IF (KSEEN.GT.50) GO TO 60
C
C             Add local value SEEN -2 to each one-level-down node
C
         KSEEN=KSEEN+80
         ISEEN=KSEEN
         CALL GSATT(ISON,'SEEN',ISEEN)
   60 CONTINUE
      CALL GDRAW(NAME,45.,135.,0.,XPOS,YPOS,XSCALE,YSCALE)
C
C             Reset global SEEN values
C
      DO 70  IVO=1,NVOLUM
         CALL UHTOC(IQ(JVOLUM+IVO),4,NAMSEE,4)
         CALL GFATT(NAMSEE,'SEEN',KSEEN)
         IF (KSEEN.LT.50) GO TO 70
         ISEENL=KSEEN/10.+0.5
         ISEENG=KSEEN-ISEENL*10.
         CALL GSATT(NAMSEE,'SEEN',ISEENG)
   70 CONTINUE
C
  999 END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1995/10/24 10:20:23 cernlib
	6	* Geant
	7	*
	8	*
	9	#include "geant321/pilot.h"
	10	*CMZ : 3.21/04 10/01/95 16.43.07 by S.Giani
	11	*-- Author :
	12	SUBROUTINE GDPRTR(NAME,YLEV,XLEV,SIZE,FACHV,
	13	+IDUP,IDRAW,IONL,IDET,ISEEN)
	14	C.
	15	C. ******************************************************************
	16	C. * *
	17	C. * Draws a box centered in (XLEV,YLEV) of size SIZE. *
	18	C. * On the top half box draws its name NAME and, if IDUP<>1, *
	19	C. * on the bottom half draw IDUP preceded by a symbol *
	20	C. * (IDUP<0 means division, IDUP>1 means multiple position, *
	21	C. * IDUP=1 means single position). *
	22	C. * If IDRAW=1 then over the box draws a normal-view of *
	23	C. * volume NAME (with same seen attributes set by GDSPEC). *
	24	C. * If IONL<>1 then draw two other boxes, slightly shifted, *
	25	C. * behind the original one. *
	26	C. * If IDET=1 then draw another box, slightly larger, *
	27	C. * around the original one. *
	28	C. * If ISEEN=0 then draw the box(es) with dashed lines. *
	29	C. * *
	30	C. * ==>Called by : GDTREE *
	31	C. * Author : P.Zanarini ; S.Giani ********* *
	32	C. * *
	33	C. ******************************************************************
	34	C.
	35	#include "geant321/gcbank.inc"
	36	#include "geant321/gcnum.inc"
	37	#include "geant321/gcdraw.inc"
	38	DIMENSION X(5),Y(5)
	39	DIMENSION NAMT0(16),NAM0(4)
	40	DIMENSION PAR(50)
	41	DIMENSION NNDM(14),INDM(4,14)
	42	DIMENSION ATT(10)
	43	CHARACTER*4 NAME,NAMSEE,ISON
	44	CHARACTER*14 CHNAM0
	45	SAVE NNDM,INDM
	46	COMMON/NPILEV/NPILE
	47	C
	48	DATA NNDM/0,0,0,4,0,2,0,2,4,3,4,3,0,0/
	49	DATA INDM/0,0,0,0, 0,0,0,0, 0,0,0,0, 2,3,7,11, 0,0,0,0,
	50	+ 4,5,0,0, 0,0,0,0, 6,7,0,0, 3,4,5,6, 4,5,6,0,
	51	+ 1,2,3,4, 1,2,3,0, 0,0,0,0, 0,0,0,0/
	52	C.
	53	C. ------------------------------------------------------------------
	54	C.
	55	IF (ISEEN.EQ.0) THEN
	56	LINSTY=4
	57	ELSE
	58	LINSTY=1
	59	ENDIF
	60	CALL MVBITS(LINSTY,0,3,LINATT,10)
	61	C
	62	C Compute box vertex
	63	C
	64	SIZ2=SIZE/2.
65	SIZ4=SIZE/4.
66	SIZ8=SIZE/8.
67	*** X(1)=XLEV-SIZ2
68	X(1)=XLEV-(SIZ22.FACHV)
69	X(2)=X(1)
70	*** X(3)=XLEV+SIZ2
71	X(3)=XLEV+(SIZ22.FACHV)
72	X(4)=X(3)
73	X(5)=X(1)
74	Y(1)=YLEV+SIZ2
75	Y(2)=YLEV-SIZ2
76	Y(3)=Y(2)
77	Y(4)=Y(1)
78	Y(5)=Y(1)
79	C
80	C Draw box
81	C
82	IWTY=IGIWTY(1)
83	CALL IGQWK(0,'HWCO',R)
84	IF(IWTY.GT.10.OR.IWTY.LT.1.OR.R.EQ.2.)THEN
85	LINCOL=1
86	CALL MVBITS(LINCOL,0,8,LINATT,16)
87	CALL GDRAWV(X,Y,5)
88	ELSE
89	CALL IGSET('LWID',1.)
90	CALL UCTOH(NAME,IIIN,4,4)
91	CALL IGPID(1,'Tree',IIIN,' ')
92	CALL IGPAVE(X(1),X(3),Y(1),Y(3),SIZ8,1004,1001,'TRS')
93	ENDIF
94	C
95	C If volume is also detector draw another box outside
96	C
97	IF (IDET.EQ.1) THEN
98	X(1)=X(1)-SIZ8
99	X(2)=X(2)-SIZ8
100	X(3)=X(3)+SIZ8
101	X(4)=X(4)+SIZ8
102	X(5)=X(5)-SIZ8
103	Y(1)=Y(1)+SIZ8
104	Y(2)=Y(2)-SIZ8
105	Y(3)=Y(3)-SIZ8
106	Y(4)=Y(4)+SIZ8
107	Y(5)=Y(5)+SIZ8
108	LINCOL=1
109	CALL MVBITS(LINCOL,0,8,LINATT,16)
110	CALL GDRAWV(X,Y,5)
111	ENDIF
112	C
113	C If volume is not 'ONLY' draw two other boxes behind
114	C
115	IF (IONL.NE.1) THEN
116	X(1)=XLEV+(SIZ22.FACHV)-SIZ8
117	Y(1)=YLEV+SIZ2
118	X(2)=X(1)
119	Y(2)=Y(1)+SIZ8
120	X(3)=X(2)-(SIZE2.FACHV)
121	Y(3)=Y(2)
122	X(4)=X(3)
123	Y(4)=Y(3)-SIZE
124	X(5)=X(4)+SIZ8
125	Y(5)=Y(4)
126	LINCOL=1
127	CALL MVBITS(LINCOL,0,8,LINATT,16)
128	CALL GDRAWV(X,Y,5)
129	DO 10 I=1,5
130	X(I)=X(I)-SIZ8
131	Y(I)=Y(I)+SIZ8
132	10 CONTINUE
133	CALL GDRAWV(X,Y,5)
134	ENDIF
135	C
136	LINSTY=1
137	CALL MVBITS(LINSTY,0,3,LINATT,10)
138	C
139	C Draw name
140	C
141	YL=YLEV-SIZ2+(SIZ8/2.)
142	IF(FACHV.EQ.1.)YL=YLEV-SIZ8
143	XL=XLEV-(SIZ4*FACHV)+SIZ8
144	IF(FACHV.EQ.1.)XL=XLEV
145	SZ=1.5SIZ42.
146	IF(FACHV.EQ.1.)SZ=1.SIZ42.
147	ITXCOL=5
148	CALL MVBITS(ITXCOL,0,4,ITXATT,3)
149	AITXCO=ITXCOL
150	CALL IGSET('TXCI',AITXCO)
151	CALL IGSET('TXFP',-60.)
152	IWTY=IGIWTY(1)
153	IF(IWTY.GT.10.OR.IWTY.LT.1)CALL IGSET('TXFP',-61.)
154	*** CALL IGPID(1,'Tree',NPILE,' ')
155	CALL GDRAWT(XL,YL,NAME,SZ,0.,4,0)
156	CALL IGSET('TXFP',2.)
157	CALL IGSET('TXCI',1.)
158	C
159	IF (IDUP.EQ.1) GO TO 20
160	C
161	C Draw IDUP in bottom half box
162	C
163	CALL UCTOH('<"4#>',NAMT0(1),1,5)
164	IF (IDUP.LT.0) CALL UCTOH('F',NAMT0(3),1,1)
165	DUP=FLOAT(IABS(IDUP))
166	CALL HBCDF(DUP,8,NAMT0(6))
167	CALL UCTOH('$',NAMT0(14),1,1)
168	CALL UBUNCH(NAMT0,NAM0,14)
169	CALL UHTOC(NAM0,4,CHNAM0,14)
170	XL=XLEV+(SIZ4*FACHV)+SIZ2
171	IF(FACHV.EQ.1.)XL=XLEV-(3.*SIZ8)
172	YL=YLEV-SIZ4-SIZ8
173	IF(FACHV.EQ.1.)YL=YLEV-SIZ2+(SIZ8/2.)
174	SZ=0.7SIZ42.
175	IF(FACHV.EQ.1.)SZ=0.7SIZ41.5
176	ITXCOL=5
177	CALL MVBITS(ITXCOL,0,4,ITXATT,3)
178	AITXCO=ITXCOL
179	CALL IGSET('TXCI',AITXCO)
180	CALL IGSET('TXFP',2.)
181	*** CALL IGPID(1,'Tree',NPILE,' ')
182	CALL GDRAWT(XL,YL,CHNAM0,SZ,0.,10,-1)
183	CALL IGSET('TXCI',1.)
184	C
185	20 CONTINUE
186	C
187	IF (IDRAW.NE.1) GO TO 999
188	C
189	C Draw a normal view of the volume
190	C
191	CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
192	IF(IVO.LE.0) GO TO 999
193	C
194	JVO=LQ(JVOLUM-IVO)
195	C
196	C GET PARAMETERS
197	C
198	CALL GFPARA(NAME,1,0,NPAR,NATT,PAR,ATT)
199	IF(NPAR.LE.0) GO TO 999
200	C
201	ISHAPE=Q(JVO+2)
202	C
203	C CHECK parametER SIZES
204	C
205	PARMAX=-1.
206	DO 50 I=1,NPAR
207	IF(ISHAPE.GT.14)GO TO 50
208	IF(NNDM(ISHAPE).LE.0) GO TO 40
209	C
210	NDM=NNDM(ISHAPE)
211	DO 30 IDM=1,NDM
212	C
213	IF(I.EQ.INDM(IDM,ISHAPE)) GO TO 50
214	C
215	30 CONTINUE
216	40 CONTINUE
217	C
218	ABSPAR=ABS(PAR(I))
219	PARMAX=MAX(PARMAX,ABSPAR)
220	50 CONTINUE
221	XSCALE=SIZE/(3.*PARMAX)
222	YSCALE=XSCALE
223	XPOS=XLEV-(SIZEFACHV2)+SIZ8
224	YPOS=YLEV
225	* YPOS=YLEV+SIZE
226	C
227	CALL GFATT(NAME,'SEEN',KSEEN)
228	C
229	C Add local value KSEEN 1 to starting node of tree
230	C
231	KSEEN=KSEEN+110
232	ISEEN=KSEEN
233	CALL GSATT(NAME,'SEEN',ISEEN)
234	C
235	CALL GDNSON(NAME,NSON,IDIV)
236	DO 60 N=1,NSON
237	CALL GDSON(N,NAME,ISON)
238	CALL GFATT(ISON,'SEEN',KSEEN)
239	C
240	C ISON is a volume with multeplicity;
241	C first occurrence has already been set
242	C
243	IF (KSEEN.GT.50) GO TO 60
244	C
245	C Add local value SEEN -2 to each one-level-down node
246	C
247	KSEEN=KSEEN+80
248	ISEEN=KSEEN
249	CALL GSATT(ISON,'SEEN',ISEEN)
250	60 CONTINUE
251	CALL GDRAW(NAME,45.,135.,0.,XPOS,YPOS,XSCALE,YSCALE)
252	C
253	C Reset global SEEN values
254	C
255	DO 70 IVO=1,NVOLUM
256	CALL UHTOC(IQ(JVOLUM+IVO),4,NAMSEE,4)
257	CALL GFATT(NAMSEE,'SEEN',KSEEN)
258	IF (KSEEN.LT.50) GO TO 70
259	ISEENL=KSEEN/10.+0.5
260	ISEENG=KSEEN-ISEENL*10.
261	CALL GSATT(NAMSEE,'SEEN',ISEENG)
262	70 CONTINUE
263	C
264	999 END