5 * Revision 1.1.1.1 1999/05/18 15:55:03 fca
8 * Revision 1.1.1.1 1995/10/24 10:20:24 cernlib
12 #include "geant321/pilot.h"
13 *CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani
15 SUBROUTINE GDRAWS(ISHAPE,PAR)
17 C. ******************************************************************
19 C. * Draw the shape number ISHAPE, of parameters PAR *
21 C. * SHAPE SHAPE SHAPE *
22 C. * NUMBER TYPE PARAMETERS *
23 C. * -------------------------------------------------------------- *
26 C. * 2 TRD1 DX1,DX2,DY,DZ *
27 C. * 3 TRD2 DX1,DX2,DY1,DY2,DZ *
28 C. * 4 TRAP DZ,TX,TY,H1,BL1,TL1,TTH1,H2,BL2,TL2,TTH2 *
30 C. * 5 TUBE RMIN,RMAX,DZ *
31 C. * 6 TUBS RMIN,RMAX,DZ,PHIMIN,PHIMAX *
32 C. * 7 CONE DZ,RMIN1,RMAX1,RMIN2,RMAX2 *
33 C. * 8 CONS DZ,RMIN1,RMAX1,RMIN2,RMAX2,PHIMIN,PHIMAX *
35 C. * 9 SPHE RMIN,RMAX,THEMIN,THEMAX,PHIMIN,PHIMAX *
37 C. * 10 PARA DX,DY,DZ,TXY,TXZ,TYZ *
38 C. * 11 PGON PHIMIN,DPHI,NDIV,NZ,Z(1),RMIN(1),RMAX(1),...*
39 C. * 12 PCON PHIMIN,DPHI,NZ,Z(1),RMIN(1),RMAX(1),Z(2),...*
41 C. * 14 HYPE RMIN,RMAX,DZ,PHI *
42 C. * NSGTRA GTRA DZ,TH,PHI,TWIST,Y1,XL1,XH1,TH1,Y2,XL2,XH2,..*
43 C. * NSCTUB CTUB RMIN,RMAX,DZ,PHIMIN,PHIMAX,LXL,LYL,LZL,LXH,.*
45 C. * ==>Called by : GDRAW *
46 C. * Author : P.Zanarini ********* *
47 C. * Modification log. *
48 C. * 1-Jun-88 A.C.McPherson - Introduce cut tube shape. *
50 C. ******************************************************************
52 #include "geant321/gcdraw.inc"
53 #include "geant321/gconsp.inc"
54 #include "geant321/gcshno.inc"
56 PARAMETER ( NLPC = 40 )
58 * The constant NLPC defined in the parameter statement
59 * is the number of line elements to form a complete
60 * circle in the surface definitions for a cut tube.
62 DIMENSION CPHIS(NLPC+1),SPHIS(NLPC+1)
64 DIMENSION X(3,46), U(46), V(46)
65 DIMENSION PAR(100),P(3,8),PP(3,8)
67 C. ------------------------------------------------------------------
69 IF (ISHAPE.NE.1) GO TO 200
80 200 IF (ISHAPE.NE.2) GO TO 300
91 300 IF (ISHAPE.NE.3) GO TO 400
102 400 IF (ISHAPE.NE.4) GO TO 500
119 500 IF (ISHAPE.NE.5) GO TO 600
131 600 IF (ISHAPE.NE.6) GO TO 700
145 700 IF (ISHAPE.NE.7) GO TO 800
157 800 IF (ISHAPE.NE.8) GO TO 900
171 900 IF (ISHAPE.NE.9) GO TO 910
181 910 IF (ISHAPE.NE.10) GO TO 911
204 911 IF (ISHAPE.NE.11) GO TO 912
212 DPHI=(PHIMAX-PHIMIN)/NDIV
214 C Z(1)=PAR(5) - RMIN(1)=PAR(6) - RMAX(1)=PAR(7) - Z(2)=PAR(8) - ...
218 912 IF (ISHAPE.NE.12) GO TO 950
226 C Z(1)=PAR(4) - RMIN(1)=PAR(5) - RMAX(1)=PAR(6) - Z(2)=PAR(7) - ...
232 IF (ISHAPE.NE.13) GO TO 951
243 IF (ISHAPE.NE.14) GO TO 955
250 TANTHS = (TAN(PAR(4)*DEGRAD))**2
253 RMIN2 = SQRT(RMIN12 + Z2*Z2*TANTHS)
254 RMAX2 = SQRT(RMAX12 + Z2*Z2*TANTHS)
259 IF(ISHAPE.NE.28) GO TO 980
261 C General twisted trapezoid.
266 P(1,IL)=PAR(I0)+PAR(I0+2)*P(3,IL)
267 P(2,IL)=PAR(I0+1)+PAR(I0+3)*P(3,IL)
269 P(1,IL+4)=PAR(I0)+PAR(I0+2)*P(3,IL+4)
270 P(2,IL+4)=PAR(I0+1)+PAR(I0+3)*P(3,IL+4)
276 IF( ISHAPE .EQ. NSCTUB ) THEN
278 DPHIS = PAR(5)-PAR(4)
279 IF( DPHIS .LE. 0.0 ) DPHIS=DPHIS+TWOPI
280 NL = MAX(DPHIS*NLPC/360.0,1.)
283 IF( PAR(4) .EQ. 0.0 .AND. PAR(5) .EQ. 360.0 ) THEN
298 C Rectilinear shapes: BOX,TRD1,TRD2
307 C Calculate the 8 vertex for rectilinear shapes
334 CALL GDRECT(P(1,1),P(1,2),P(1,3),P(1,4))
335 CALL GDRECT(P(1,5),P(1,6),P(1,7),P(1,8))
336 CALL GDLINE(P(1,1),P(1,5))
337 CALL GDLINE(P(1,2),P(1,6))
338 CALL GDLINE(P(1,3),P(1,7))
339 CALL GDLINE(P(1,4),P(1,8))
347 C Calculate the 8 vertex
349 P(1,1)=-DZ*TX+TTH1*H1+TL1
352 P(1,2)=-DZ*TX+TTH1*H1-TL1
355 P(1,3)=-DZ*TX-TTH1*H1-BL1
358 P(1,4)=-DZ*TX-TTH1*H1+BL1
361 P(1,5)=+DZ*TX+TTH2*H2+TL2
364 P(1,6)=+DZ*TX+TTH2*H2-TL2
367 P(1,7)=+DZ*TX-TTH2*H2-BL2
370 P(1,8)=+DZ*TX-TTH2*H2+BL2
376 CALL GDRECT(P(1,1),P(1,2),P(1,3),P(1,4))
377 CALL GDRECT(P(1,5),P(1,6),P(1,7),P(1,8))
378 CALL GDLINE(P(1,1),P(1,5))
379 CALL GDLINE(P(1,2),P(1,6))
380 CALL GDLINE(P(1,3),P(1,7))
381 CALL GDLINE(P(1,4),P(1,8))
383 C Condition for plane sides are :
389 C H2*(BL1-TL1)=H1(BL2-TL2)
391 C In that case we should draw on each side 10 lines
392 C (perpendicular to side lines) to make an easy
393 C visualisation that sides are not planes
399 C Cylindric shapes: TUBE,CONE
401 CALL GDCIRC(RMAX1,Z1)
402 CALL GDCIRC(RMIN1,Z1)
403 CALL GDCIRC(RMAX2,Z2)
404 CALL GDCIRC(RMIN2,Z2)
407 CALL GDLCYL(RMIN1,PHIP,Z1,RMIN2,PHIP,Z2)
408 CALL GDLCYL(RMIN1,PHIM,Z1,RMIN2,PHIM,Z2)
409 CALL GDLCYL(RMAX1,PHIP,Z1,RMAX2,PHIP,Z2)
410 CALL GDLCYL(RMAX1,PHIM,Z1,RMAX2,PHIM,Z2)
416 C Segmented cylindric shapes: TUBS,CONS
418 CALL GDARC(RMAX1,Z1,PHIMIN,PHIMAX)
419 CALL GDARC(RMIN1,Z1,PHIMIN,PHIMAX)
420 CALL GDARC(RMAX2,Z2,PHIMIN,PHIMAX)
421 CALL GDARC(RMIN2,Z2,PHIMIN,PHIMAX)
422 PHIP=AMOD((GPHI+90.),360.)
423 PHIM=AMOD((GPHI+270.),360.)
424 IF (PHIP.LE.PHIMIN.OR.PHIP.GE.PHIMAX) GO TO 2510
425 CALL GDLCYL(RMIN1,PHIP,Z1,RMIN2,PHIP,Z2)
426 CALL GDLCYL(RMAX1,PHIP,Z1,RMAX2,PHIP,Z2)
427 2510 IF (PHIM.LE.PHIMIN.OR.PHIM.GE.PHIMAX) GO TO 2520
428 CALL GDLCYL(RMIN1,PHIM,Z1,RMIN2,PHIM,Z2)
429 CALL GDLCYL(RMAX1,PHIM,Z1,RMAX2,PHIM,Z2)
430 2520 CALL GDLCYL(RMAX1,PHIMIN,Z1,RMAX2,PHIMIN,Z2)
431 CALL GDLCYL(RMAX1,PHIMAX,Z1,RMAX2,PHIMAX,Z2)
432 CALL GDLCYL(RMIN1,PHIMIN,Z1,RMIN2,PHIMIN,Z2)
433 CALL GDLCYL(RMIN1,PHIMAX,Z1,RMIN2,PHIMAX,Z2)
434 CALL GDLCYL(RMAX1,PHIMIN,Z1,RMIN1,PHIMIN,Z1)
435 CALL GDLCYL(RMAX2,PHIMIN,Z2,RMIN2,PHIMIN,Z2)
436 CALL GDLCYL(RMAX1,PHIMAX,Z1,RMIN1,PHIMAX,Z1)
437 CALL GDLCYL(RMAX2,PHIMAX,Z2,RMIN2,PHIMAX,Z2)
445 CALL GDARC(RMAX,0.,PHMI,PHMA)
446 CALL GDARC(RMIN,0.,PHMI,PHMA)
448 IF(DP.LE.0.) DP=DP+360.
449 NSTEP = MAX(DP/15.,1.)
459 X(1,J) = RMAX*SIN(THET)*COSPH
460 X(2,J) = RMAX*SIN(THET)*SINPH
461 X(3,J) = RMAX*COS(THET)
463 CALL GDFR3D(X,46,U,V)
475 X(1,J) = RMIN*SIN(THET)*COSPH
476 X(2,J) = RMIN*SIN(THET)*SINPH
477 X(3,J) = RMIN*COS(THET)
479 CALL GDFR3D(X,46,U,V)
493 CALL GDLINE(P(1,1),P(1,2))
494 CALL GDLINE(P(1,3),P(1,4))
495 CALL GDLINE(P(1,5),P(1,6))
497 P(1,1) = RMIN*COS(PHMI*DEGRAD)
498 P(2,1) = RMIN*SIN(PHMI*DEGRAD)
499 P(1,2) = RMAX*COS(PHMI*DEGRAD)
500 P(2,2) = RMAX*SIN(PHMI*DEGRAD)
501 CALL GDLINE(P(1,1),P(1,2))
502 P(1,1) = RMIN*COS(PHMA*DEGRAD)
503 P(2,1) = RMIN*SIN(PHMA*DEGRAD)
504 P(1,2) = RMAX*COS(PHMA*DEGRAD)
505 P(2,2) = RMAX*SIN(PHMA*DEGRAD)
506 CALL GDLINE(P(1,1),P(1,2))
509 CALL GDLINE(P(1,3),P(1,4))
512 CALL GDLINE(P(1,3),P(1,4))
520 FACT=1./COS(DEGRAD*DPHI/2.)
522 PAR(6+(IZ-1)*3)=PAR(6+(IZ-1)*3)*FACT
523 PAR(7+(IZ-1)*3)=PAR(7+(IZ-1)*3)*FACT
532 IF (IZ.EQ.1.OR.IZ.EQ.NZ) GO TO 4003
533 R0PRE=PAR(6+(IZ-2)*3)
535 IF (R0.EQ.R0PRE)GO TO 4006
536 IF (R0.EQ.R0POST)GO TO 4006
539 PHI0=PHIMIN+(IDIV-1)*DPHI
541 CALL GDLCYL(R0,PHI0,ZI,R0,PHI1,ZI)
544 4006 IF (IZ.EQ.1.OR.IZ.EQ.NZ) GO TO 4008
545 R1PRE=PAR(7+(IZ-2)*3)
547 IF (R1.EQ.R1PRE )GO TO 4020
548 IF (R1.EQ.R1POST)GO TO 4020
551 PHI0=PHIMIN+(IDIV-1)*DPHI
553 CALL GDLCYL(R1,PHI0,ZI,R1,PHI1,ZI)
556 4020 IF ((IZ.EQ.1.OR.IZ.EQ.NZ).AND.(PHIMAX-PHIMIN.NE.360.)) THEN
557 CALL GDLCYL(R0,PHIMIN,ZI,R1,PHIMIN,ZI)
558 CALL GDLCYL(R0,PHIMAX,ZI,R1,PHIMAX,ZI)
561 IF (IZ.EQ.1) GO TO 4050
567 PH=PHIMIN+(IDIV-1)*DPHI
568 CALL GDLCYL(R00,PH,ZI0,R0,PH,ZI)
569 CALL GDLCYL(R10,PH,ZI0,R1,PH,ZI)
571 CALL GDLCYL(R00,PHIMAX,ZI0,R0,PHIMAX,ZI)
572 CALL GDLCYL(R10,PHIMAX,ZI0,R1,PHIMAX,ZI)
586 IF (IZ.EQ.1.OR.IZ.EQ.NZ) GO TO 5010
587 R1PRE=PAR(6+(IZ-2)*3)
589 IF (R1.LE.R1PRE.OR.R1.LE.R1POST) GO TO 5015
591 CALL GDARC(R0,ZI,PHIMIN,PHIMAX)
592 CALL GDARC(R1,ZI,PHIMIN,PHIMAX)
594 IF ((PHIMAX-PHIMIN).EQ.360.) GO TO 5020
595 CALL GDLCYL(R0,PHIMIN,ZI,R1,PHIMIN,ZI)
596 CALL GDLCYL(R0,PHIMAX,ZI,R1,PHIMAX,ZI)
598 IF (IZ.EQ.1) GO TO 5555
602 IF ((PHIMAX-PHIMIN).EQ.360.) GO TO 5030
603 CALL GDLCYL(R00,PHIMIN,ZI0,R0,PHIMIN,ZI)
604 CALL GDLCYL(R10,PHIMIN,ZI0,R1,PHIMIN,ZI)
605 CALL GDLCYL(R00,PHIMAX,ZI0,R0,PHIMAX,ZI)
606 CALL GDLCYL(R10,PHIMAX,ZI0,R1,PHIMAX,ZI)
609 PHIP=AMOD((GPHI+90.),360.)
610 PHIM=AMOD((GPHI+270.),360.)
611 IF (PHIP.LT.PHIMIN.OR.PHIP.GT.PHIMAX) GO TO 5510
612 CALL GDLCYL(R00,PHIP,ZI0,R0,PHIP,ZI)
613 CALL GDLCYL(R10,PHIP,ZI0,R1,PHIP,ZI)
614 5510 IF (PHIM.LT.PHIMIN.OR.PHIM.GT.PHIMAX) GO TO 5555
615 CALL GDLCYL(R00,PHIM,ZI0,R0,PHIM,ZI)
616 CALL GDLCYL(R10,PHIM,ZI0,R1,PHIM,ZI)
625 CPHIS(1) = COS( PHIS*DEGRAD )
626 SPHIS(1) = SIN( PHIS*DEGRAD )
629 CPHIS(I+1) = COS( PHIS*DEGRAD )
630 SPHIS(I+1) = SIN( PHIS*DEGRAD )
632 P( 1, 1) = PAR(2)*CPHIS(1)
633 P( 2, 1) = PAR(2)*SPHIS(1)
634 P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8)
636 P( 1, 4) = PAR(1)*CPHIS(1)
637 P( 2, 4) = PAR(1)*SPHIS(1)
638 P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8)
640 P( 1, 5) = PAR(2)*CPHIS(1)
641 P( 2, 5) = PAR(2)*SPHIS(1)
642 P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11)
644 P( 1, 8) = PAR(1)*CPHIS(1)
645 P( 2, 8) = PAR(1)*SPHIS(1)
646 P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11)
649 IF( ISEG .EQ. 1 ) THEN
650 CALL GDRECT( P( 1, 1), P( 1, 4), P( 1, 8), P( 1, 5) )
654 P( 1, 2) = PAR(2)*CPHIS(I+1)
655 P( 2, 2) = PAR(2)*SPHIS(I+1)
656 P( 3, 2) = -( PAR( 6)*P( 1, 2) +PAR( 7)*P( 2, 2) )/PAR( 8)
658 CALL GDLINE( P( 1, 1), P( 1, 2) )
665 P( 1, 3) = PAR(1)*CPHIS(I+1)
666 P( 2, 3) = PAR(1)*SPHIS(I+1)
667 P( 3, 3) = -( PAR( 6)*P( 1, 3) +PAR( 7)*P( 2, 3) )/PAR( 8)
669 CALL GDLINE( P( 1, 4), P( 1, 3) )
676 P( 1, 6) = PAR(2)*CPHIS(I+1)
677 P( 2, 6) = PAR(2)*SPHIS(I+1)
678 P( 3, 6) = -( PAR( 9)*P( 1, 6) +PAR( 10)*P( 2, 6) )/PAR( 11)
680 CALL GDLINE( P( 1, 5), P( 1, 6) )
687 P( 1, 7) = PAR(1)*CPHIS(I+1)
688 P( 2, 7) = PAR(1)*SPHIS(I+1)
689 P( 3, 7) = -( PAR( 9)*P( 1, 7) +PAR( 10)*P( 2, 7) )/PAR( 11)
691 CALL GDLINE( P( 1, 8), P( 1, 7) )
697 IF( ISEG .EQ. 1 ) THEN
698 CALL GDRECT( P( 1, 1), P( 1, 4), P( 1, 8), P( 1, 5) )
701 PHIP = AMOD( GPHI+90.0, 360.0 )
702 PHIM = AMOD( GPHI+270.0, 360.0 )
705 IF( DPHIP .LT. 0.0 ) DPHIP = DPHIP+TWOPI
706 IF( DPHIM .LT. 0.0 ) DPHIM = DPHIM+TWOPI
708 IF( DPHIP .LE. DPHIS ) THEN
709 CP = COS( PHIP*DEGRAD )
710 SP = SIN( PHIP*DEGRAD )
713 P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8)
717 P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8)
721 P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11)
725 P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11)
727 CALL GDLINE( P( 1, 1), P( 1, 5) )
728 CALL GDLINE( P( 1, 4), P( 1, 8) )
732 IF( DPHIM .LE. DPHIS ) THEN
733 CP = COS( PHIM*DEGRAD )
734 SP = SIN( PHIM*DEGRAD )
737 P( 3, 1) = -( PAR( 6)*P( 1, 1) +PAR( 7)*P( 2, 1) )/PAR( 8)
741 P( 3, 4) = -( PAR( 6)*P( 1, 4) +PAR( 7)*P( 2, 4) )/PAR( 8)
745 P( 3, 5) = -( PAR( 9)*P( 1, 5) +PAR( 10)*P( 2, 5) )/PAR( 11)
749 P( 3, 8) = -( PAR( 9)*P( 1, 8) +PAR( 10)*P( 2, 8) )/PAR( 11)
751 CALL GDLINE( P( 1, 1), P( 1, 5) )
752 CALL GDLINE( P( 1, 4), P( 1, 8) )
775 CALL GDLINE(P(1,1),P(1,2))
776 CALL GDLINE(P(1,3),P(1,4))
788 CALL GDCIRC(RMAX2,Z1)
789 CALL GDCIRC(RMIN2,Z1)
790 CALL GDCIRC(RMAX2,Z2)
791 CALL GDCIRC(RMIN2,Z2)
794 DO 7440 IZ = 1, NZSTEP
799 PP(2,2) = SQRT(RMAX12 + ZZZ)
800 PP(2,4) = SQRT(RMIN12 + ZZZ)
801 DO 7430 ISY = -1, +1, 2
802 DO 7430 ISZ = -1, +1, 2
804 P(2,J) = ISY * PP(2,J)
805 P(3,J) = ISZ * PP(3,J)
807 CALL GDLINE(P(1,1),P(1,2))
808 CALL GDLINE(P(1,3),P(1,4))