]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gdraw/gdspec.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
100 parameters now allowed for geant shapes
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdspec.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
d43b40e2 5* Revision 1.1.1.1 1999/05/18 15:55:03 fca
6* AliRoot sources
7*
fe4da5cc 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)
22C.
23C. ******************************************************************
24C. * *
25C. * This routine draws specifications of volume NAME *
26C. * *
27C. * ==>Called by : <USER>, <GXINT>, GDFSPC *
28C. * Authors : P.Zanarini ********* *
29C. * A.McPherson ***** *
30C. * *
31C. ******************************************************************
32C.
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)
d43b40e2 42 DIMENSION PAR(100),IPAR(12),IPA(3),ISPAR(3)
fe4da5cc 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
50C
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 '/
70C
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/
76C
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/
83C.
84C. ------------------------------------------------------------------
85C.
86C Is NAME an existing volume ?
87C
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
92C
93C Normalize to PLTRNX,PLTRNY
94C
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.
101C
102C Save GDRAW calling parameters
103C and ZOOM internal parameters
104C
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
124C
125C Get shape type
126C
127 JVO=LQ(JVOLUM-IVO)
128 ISHAPE=Q(JVO+2)
129C
130C Get user parameters
131C
132 CALL GFPARA(NAME,1,0,NPAR,NATT,PAR,ATT)
133 IF(NPAR.LE.0) GO TO 250
134C
135C
136C Check parameter sizes
137C
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
148C
149 GSCU=MIN(PLTRNX,PLTRNY)/(7.*PARMAX)
150 GSCV=GSCU
151 AXSIZ=PARMAX*0.35
152C
153C Draw header
154C
155 CALL GDHEAD(-1,NAME,0.)
156C
157C Draw parameters list
158C
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
163C
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)
262C
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
280C
281 190 CONTINUE
282C
283C Cut tube
284C
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
298C
299C General twisted trapezoid.
300C
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)
307C
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
332C
333C Draw views
334C
335 CALL GFATT(NAME,'SEEN',KSEEN)
336C
337C Add local value SEEN 1 to starting node of tree
338C
339 KSEEN=KSEEN+110
340 ISEEN=KSEEN
341 CALL GSATT(NAME,'SEEN',ISEEN)
342C
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)
348C
349C ISON is a volume with multiplicity;
350C first occurrence has already been set
351C
352 IF (KSEEN.GT.50) GO TO 220
353C
354C Add local value SEEN -2 to each one-level-down node
355C
356 KSEEN=KSEEN+80
357 ISEEN=KSEEN
358 CALL GSATT(ISON,'SEEN',ISEEN)
359C
360 CALL GSATT(ISON,'COLO',4)
361 220 CONTINUE
362C
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)
369C
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)
376C
377 230 CALL GDCOL(0)
378C
379C Reset global SEEN values
380C
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
389C
390 250 CONTINUE
391C
392C Restore GDRAW calling parameters
393C and ZOOM internal parameters
394C
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