5 * Revision 1.1.1.1 1995/10/24 10:20:19 cernlib
9 #include "geant321/pilot.h"
10 #if defined(CERNLIB_CG)
11 *CMZ : 3.21/02 29/03/94 15.41.25 by S.Giani
13 SUBROUTINE GD16V(IWOFFS,SHADE)
14 ************************************************************************
17 * Author: S.Giani Date: 18.07.91 *
20 * Function: Vizualisation of WIRE-object *
21 * Search and construction of faces' visible portions *
22 * Surface filling for WIRE-object *
23 * Two scan line algorithms *
26 * References: CGVHED *
28 * Input: Q(JCG+IWOFFS+*) - WIRE-object *
29 * Q(JCG+*) - HIDE-structure *
35 ************************************************************************
36 #include "geant321/gcbank.inc"
37 #include "geant321/gcunit.inc"
38 #include "geant321/cggpar.inc"
39 #include "geant321/cghpar.inc"
40 #include "geant321/cgdelt.inc"
41 #include "geant321/cgctra.inc"
42 #include "geant321/cgcedg.inc"
43 #include "geant321/gcdraw.inc"
44 #include "geant321/gcflag.inc"
45 #include "geant321/gcspee.inc"
46 #include "geant321/gconst.inc"
47 #include "geant321/gchiln.inc"
50 REAL P1(3),P2(3),AX(2),AY(2)
52 DIMENSION ISCFAC(500),SCXYZ(3,500),COSDIR(4)
53 DIMENSION CX(500),CY(500),CZ(500)
54 DIMENSION TESTX(2),TESTY(2)
55 DIMENSION VVX(500),VVY(500)
57 DIMENSION AROT(4,4),ZROT(4,4),CXROT(500),CYROT(500),CZROT(500)
58 DIMENSION PXINT(50),PZINT(50),XPINT(50),YPINT(50),ZPINT(50),RRR(4)
61 ***** CALL IGSET('SYNC',1.)
62 IF (Q(JCG+IWOFFS+KCGSIZ) .LE. 0.) THEN
66 IF (Q(JCG+KHSIZE) .LE. LHHEAD) THEN
76 LINFIL=IBITS(LINATT,13,3)
77 IF(LINFIL.NE.0)CALL GDRAWV(TESTX,TESTY,-1)
89 IF (NT.LE.0 .OR. NT.GT.NTMAX) GOTO 400
90 NEDGE = Q(JCG+IWOFFS+KCGNF)
91 * IF(NEDGE.EQ.0)GOTO 49
100 NFACE = Q(JCG+KHNFAC)
104 DO 180 MMM=2,SHADE(1)
105 IF(NE.EQ.(SHADE(MMM)+1).AND.NE.NE.1)THEN
106 *** IF((LFULL+LPARZ).EQ.0)GOTO 260
107 CALL CGFAC2(CX,CY,CZ,LMN)
115 CALL CGHPLA(ISCFAC,SCXYZ,COSDIR)
116 XCOSX=(SIN(GTHETA*DEGRAD))*(COS(GPHI*DEGRAD))
117 YCOSY=(SIN(GTHETA*DEGRAD))*(SIN(GPHI*DEGRAD))
118 ZCOSZ=COS(GTHETA*DEGRAD)
119 PROSCA=(COSDIR(1)*XCOSX)+(COSDIR(2)*YCOSY)+
121 PROSCB=(2.*(PROSCA**2))-1.
123 * IF(APROSC.LT.-1.)PRINT *,'GT1'
124 IF(LFULL.EQ.(IJKLMN/2).AND.
125 + (LINFIL.EQ.2.OR.LINFIL.EQ.3))THEN
126 CALL CGFACO(VVX,VVY,IJKLMN,LFULL,APROSC)
128 IF(ISWIT(10).EQ.100)THEN
133 IF(APNZ.LT..0001)THEN
140 AROT(1,1)=PNX*PNZ/SQRT(PNX**2+PNY**2)
141 AROT(1,2)=PNY*PNZ/SQRT(PNX**2+PNY**2)
142 AROT(1,3)=-SQRT(PNX**2+PNY**2)
143 AROT(2,1)=-PNY/SQRT(PNX**2+PNY**2)
144 AROT(2,2)=PNX/SQRT(PNX**2+PNY**2)
153 AROT(IHH,JHH)=TSCRN(JHH,IHH,NT)
161 IF(ISWIT(10).EQ.100)THEN
174 ZROT(IHH,JHH)=AROT(IHH,JHH)
177 CALL RINV(4,ZROT,4,RRR,IFAIL)
182 IF(ISWIT(10).EQ.100)THEN
183 CXROT(M)=AROT(1,1)*CX(M)+ AROT(1,2)*CY(M)
185 CYROT(M)=AROT(2,1)*CX(M)+ AROT(2,2)*CY(M)
187 CZROT(M)=AROT(3,1)*CX(M)+ AROT(3,2)*CY(M)
190 CXROT(M)=AROT(1,4)+AROT(1,1)*CX(M)+
191 + AROT(1,2)*CY(M)+AROT(1,3)*CZ(M)
192 CYROT(M)=AROT(2,4)+AROT(2,1)*CX(M)+
193 + AROT(2,2)*CY(M)+AROT(2,3)*CZ(M)
194 CZROT(M)=AROT(3,4)+AROT(3,1)*CX(M)+
195 + AROT(3,2)*CY(M)+AROT(3,3)*CZ(M)
197 IF(CYROT(M).LT.YROTMI)YROTMI=CYROT(M)
198 IF(CYROT(M).GT.YROTMA)YROTMA=CYROT(M)
202 ELSEIF(LINFIL.EQ.2)THEN
204 ELSEIF(LINFIL.EQ.3)THEN
206 ELSEIF(LINFIL.EQ.4)THEN
208 ELSEIF(LINFIL.EQ.5)THEN
210 ELSEIF(LINFIL.EQ.6)THEN
212 ELSEIF(LINFIL.EQ.7)THEN
215 NYROTM=(YROTMA-YROTMI)/RINULI
221 IF(CXROT(MMI).EQ.CXROT(MMI+1))THEN
222 IF(MIN(CYROT(MMI),CYROT(MMI+1)).LT.
223 + YROTST.AND.MAX(CYROT(MMI),CYROT(MMI+1)
226 PXINT(JFK)=CXROT(MMI)
227 IF(CZROT(MMI).EQ.CZROT(MMI+1))THEN
228 PZINT(JFK)=CZROT(MMI)
229 ELSEIF(CYROT(MMI).NE.CYROT(MMI+1))
231 AAAZ=(CYROT(MMI)-CYROT(MMI+1))/
232 + (CZROT(MMI)-CZROT(MMI+1))
233 BBBZ=(CZROT(MMI)*CYROT(MMI+1)-
234 + CYROT(MMI)*CZROT(MMI+1))/ (CZROT(MM
236 PZINT(JFK)=(YROTST-BBBZ)/AAAZ
239 ELSEIF(CYROT(MMI).NE.CYROT(MMI+1))THEN
240 IF(MIN(CYROT(MMI),CYROT(MMI+1)).LT.
241 + YROTST.AND.MAX(CYROT(MMI),CYROT(MMI+1)
243 AAA=(CYROT(MMI)-CYROT(MMI+1))/
244 + (CXROT(MMI)-CXROT(MMI+1))
245 BBB=(CXROT(MMI)*CYROT(MMI+1)-
246 + CYROT(MMI)*CXROT(MMI+1))/ (CXROT(MM
249 PXINT(JFK)=(YROTST-BBB)/AAA
250 IF(CZROT(MMI).EQ.CZROT(MMI+1))THEN
251 PZINT(JFK)=CZROT(MMI)
252 ELSEIF(CYROT(MMI).NE.CYROT(MMI+1))
254 AAAZ=(CYROT(MMI)-CYROT(MMI+1))/
255 + (CZROT(MMI)-CZROT(MMI+1))
256 BBBZ=(CZROT(MMI)*CYROT(MMI+1)-
257 + CYROT(MMI)*CZROT(MMI+1))/ (CZROT(MM
259 PZINT(JFK)=(YROTST-BBBZ)/AAAZ
266 IF(PXINT(JM).LT.PXINT(KM))THEN
278 * IF((RJFK-IRJFK).GT..1)PRINT *,'Odd !'
280 IF(ISWIT(10).EQ.100)THEN
281 XPINT(MR)=ZROT(1,1)*PXINT(MR)+ ZROT(1,
282 + 2)*YROTST+ZROT(1,3)*CZROT(1)
283 YPINT(MR)=ZROT(2,1)*PXINT(MR)+ ZROT(2,
284 + 2)*YROTST+ZROT(2,3)*CZROT(1)
285 ZPINT(MR)=ZROT(3,1)*PXINT(MR)+ ZROT(3,
286 + 2)*YROTST+ZROT(3,3)*CZROT(1)
288 XPINT(MR)=ZROT(1,4)+ZROT(1,1)*
289 + PXINT(MR)+ ZROT(1,2)*YROTST+ZROT(1,3)*
291 YPINT(MR)=ZROT(2,4)+ZROT(2,1)*
292 + PXINT(MR)+ ZROT(2,2)*YROTST+ZROT(2,3)*
294 ZPINT(MR)=ZROT(3,4)+ZROT(3,1)*
295 + PXINT(MR)+ ZROT(3,2)*YROTST+ZROT(3,3)*
300 LINCOL=IBITS(LINATT,16,8)
301 CALL GDSHAD(LINCOL,APROSC)
310 CALL CGVEDG(NT,P1,P2,IVIS)
311 IF (IVIS .LT. 0) GOTO 150
312 IF (NFACE .EQ. 0) GOTO 140
313 CALL CGVHED( Q(JCG+JXYZ1),IQ(JCG+JFA),
314 + IQ(JCG+JPFA), Q(JCG+ JDFA),IQ(JCG+JTRE),
315 + IQ(JCG+JSTA), Q(JCG+JALE),Q(JCG+JARI))
317 IF (NPART) 150,140,120
318 120 DO 130 I=1,NPART+1
319 IF (I .EQ. 1) T1 = 0.
320 IF (I .NE. 1) T1 = TEND(I-1)
321 IF (I .NE. NPART+1) T2 = TSTRT(I)
322 IF (I .EQ. NPART+1) T2 = 1.
323 IF (T2-T1 .LT. TDEL) GOTO 130
324 AX(1) = XA + T1*XDELT
325 AY(1) = YA + T1*YDELT
326 AX(2) = XA + T2*XDELT
327 AY(2) = YA + T2*YDELT
328 IF(LINFIL.GT.1.AND.IDVIEW.NE.0)THEN
330 CALL MVBITS(LINCOL,0,8,LINATT,16)
338 * L I N E I S F U L L Y V I S I B L E
344 IF(LINFIL.GT.1.AND.IDVIEW.NE.0)THEN
346 CALL MVBITS(LINCOL,0,8,LINATT,16)
356 * Resetting counters for next face
371 J = LCGHEA + (NE-1)*LCGEDG
372 * IEA = Q(JCG+IWOFFS+J+KCGAE)
373 P1(1) = Q(JCG+IWOFFS+J+KCGX1)
374 P1(2) = Q(JCG+IWOFFS+J+KCGY1)
375 P1(3) = Q(JCG+IWOFFS+J+KCGZ1)
376 P2(1) = Q(JCG+IWOFFS+J+KCGX2)
377 P2(2) = Q(JCG+IWOFFS+J+KCGY2)
378 P2(3) = Q(JCG+IWOFFS+J+KCGZ2)
395 CALL CGVEDG(NT,P1,P2,IVIS)
398 * IF(IJKLMN.GE.500)THEN
399 * PRINT *,IJKLMN,'=IJKLMN'
404 * IF(IJKLMN.GE.500)THEN
405 * PRINT *,IJKLMN,'=IJKLMN'
410 IF (IVIS .LT. 0) GOTO 230
411 IF (NFACE .EQ. 0) GOTO 220
412 CALL CGVHED( Q(JCG+JXYZ1),IQ(JCG+JFA),IQ(JCG+JPFA), Q(JCG+
413 + JDFA),IQ(JCG+JTRE),IQ(JCG+JSTA), Q(JCG+JALE),Q(JCG+JARI))
415 IF (NPART) 230,220,200
416 200 DO 210 I=1,NPART+1
417 IF (I .EQ. 1) T1 = 0.
418 IF (I .NE. 1) T1 = TEND(I-1)
419 IF (I .NE. NPART+1) T2 = TSTRT(I)
420 IF (I .EQ. NPART+1) T2 = 1.
421 IF (T2-T1 .LT. TDEL) GOTO 210
422 AX(1) = XA + T1*XDELT
423 AY(1) = YA + T1*YDELT
424 AX(2) = XA + T2*XDELT
425 AY(2) = YA + T2*YDELT
427 LTY=IBITS(LINATT,10,3)
428 CALL MVBITS(6,0,3,LINATT,10)
433 CALL MVBITS(LTY,0,3,LINATT,10)
440 * L I N E I S F U L L Y V I S I B L E
447 LTY=IBITS(LINATT,10,3)
448 CALL MVBITS(6,0,3,LINATT,10)
453 CALL MVBITS(LTY,0,3,LINATT,10)
461 *** IF((LFULL+LPARZ).EQ.0)GOTO 555
462 CALL CGFAC2(CX,CY,CZ,LMN)
470 CALL CGHPLA(ISCFAC,SCXYZ,COSDIR)
471 XCOSX=(SIN(GTHETA*DEGRAD))*(COS(GPHI*DEGRAD))
472 YCOSY=(SIN(GTHETA*DEGRAD))*(SIN(GPHI*DEGRAD))
473 ZCOSZ=COS(GTHETA*DEGRAD)
474 PROSCA=(COSDIR(1)*XCOSX)+(COSDIR(2)*YCOSY)+ (COSDIR(3)*ZCOSZ)
475 PROSCB=(2.*(PROSCA**2))-1.
477 * IF(APROSC.GT.1)PRINT *,'GT1'
478 IF(LFULL.EQ.IJKLMN/2.AND.
479 + (LINFIL.EQ.2.OR.LINFIL.EQ.3))THEN
480 CALL CGFACO(VVX,VVY,IJKLMN,LFULL,APROSC)
482 IF(ISWIT(10).EQ.100)THEN
487 IF(APNZ.LT..0001)THEN
494 AROT(1,1)=PNX*PNZ/SQRT(PNX**2+PNY**2)
495 AROT(1,2)=PNY*PNZ/SQRT(PNX**2+PNY**2)
496 AROT(1,3)=-SQRT(PNX**2+PNY**2)
497 AROT(2,1)=-PNY/SQRT(PNX**2+PNY**2)
498 AROT(2,2)=PNX/SQRT(PNX**2+PNY**2)
507 AROT(IHH,JHH)=TSCRN(JHH,IHH,NT)
515 IF(ISWIT(10).EQ.100)THEN
528 ZROT(IHH,JHH)=AROT(IHH,JHH)
531 CALL RINV(4,ZROT,4,RRR,IFAIL)
536 IF(ISWIT(10).EQ.100)THEN
537 CXROT(M)=AROT(1,1)*CX(M)+ AROT(1,2)*CY(M)+AROT(1,3)*
539 CYROT(M)=AROT(2,1)*CX(M)+ AROT(2,2)*CY(M)+AROT(2,3)*
541 CZROT(M)=AROT(3,1)*CX(M)+ AROT(3,2)*CY(M)+AROT(3,3)*
544 CXROT(M)=AROT(1,4)+AROT(1,1)*CX(M)+ AROT(1,2)*CY(M)+
546 CYROT(M)=AROT(2,4)+AROT(2,1)*CX(M)+ AROT(2,2)*CY(M)+
548 CZROT(M)=AROT(3,4)+AROT(3,1)*CX(M)+ AROT(3,2)*CY(M)+
551 IF(CYROT(M).LT.YROTMI)YROTMI=CYROT(M)
552 IF(CYROT(M).GT.YROTMA)YROTMA=CYROT(M)
556 ELSEIF(LINFIL.EQ.2)THEN
558 ELSEIF(LINFIL.EQ.3)THEN
560 ELSEIF(LINFIL.EQ.4)THEN
562 ELSEIF(LINFIL.EQ.5)THEN
564 ELSEIF(LINFIL.EQ.6)THEN
566 ELSEIF(LINFIL.EQ.7)THEN
569 NYROTM=(YROTMA-YROTMI)/RINULI
575 IF(CXROT(MMI).EQ.CXROT(MMI+1))THEN
576 IF(MIN(CYROT(MMI),CYROT(MMI+1)).LT. YROTST.AND.MAX
577 + (CYROT(MMI),CYROT(MMI+1)) .GT.YROTST)THEN
579 PXINT(JFK)=CXROT(MMI)
580 IF(CZROT(MMI).EQ.CZROT(MMI+1))THEN
581 PZINT(JFK)=CZROT(MMI)
582 ELSEIF(CYROT(MMI).NE.CYROT(MMI+1))THEN
583 AAAZ=(CYROT(MMI)-CYROT(MMI+1))/ (CZROT(MMI)-
585 BBBZ=(CZROT(MMI)*CYROT(MMI+1)- CYROT(MMI)*
586 + CZROT(MMI+1))/ (CZROT(MMI)-CZROT(MMI+1))
587 PZINT(JFK)=(YROTST-BBBZ)/AAAZ
590 ELSEIF(CYROT(MMI).NE.CYROT(MMI+1))THEN
591 IF(MIN(CYROT(MMI),CYROT(MMI+1)).LT. YROTST.AND.MAX
592 + (CYROT(MMI),CYROT(MMI+1)) .GT.YROTST)THEN
593 AAA=(CYROT(MMI)-CYROT(MMI+1))/ (CXROT(MMI)-
595 BBB=(CXROT(MMI)*CYROT(MMI+1)- CYROT(MMI)*
596 + CXROT(MMI+1))/ (CXROT(MMI)-CXROT(MMI+1))
598 PXINT(JFK)=(YROTST-BBB)/AAA
599 IF(CZROT(MMI).EQ.CZROT(MMI+1))THEN
600 PZINT(JFK)=CZROT(MMI)
601 ELSEIF(CYROT(MMI).NE.CYROT(MMI+1))THEN
602 AAAZ=(CYROT(MMI)-CYROT(MMI+1))/ (CZROT(MMI)-
604 BBBZ=(CZROT(MMI)*CYROT(MMI+1)- CYROT(MMI)*
605 + CZROT(MMI+1))/ (CZROT(MMI)-CZROT(MMI+1))
606 PZINT(JFK)=(YROTST-BBBZ)/AAAZ
613 IF(PXINT(JM).LT.PXINT(KM))THEN
625 * IF((RJFK-IRJFK).GT..1)PRINT *,'Odd !'
627 IF(ISWIT(10).EQ.100)THEN
628 XPINT(MR)=ZROT(1,1)*PXINT(MR)+ ZROT(1,2)*YROTST+
630 YPINT(MR)=ZROT(2,1)*PXINT(MR)+ ZROT(2,2)*YROTST+
632 ZPINT(MR)=ZROT(3,1)*PXINT(MR)+ ZROT(3,2)*YROTST+
635 XPINT(MR)=ZROT(1,4)+ZROT(1,1)*PXINT(MR)+ ZROT(1,2)
636 + *YROTST+ZROT(1,3)*PZINT(MR)
637 YPINT(MR)=ZROT(2,4)+ZROT(2,1)*PXINT(MR)+ ZROT(2,2)
638 + *YROTST+ZROT(2,3)*PZINT(MR)
639 ZPINT(MR)=ZROT(3,4)+ZROT(3,1)*PXINT(MR)+ ZROT(3,2)
640 + *YROTST+ZROT(3,3)*PZINT(MR)
644 LINCOL=IBITS(LINATT,16,8)
645 CALL GDSHAD(LINCOL,APROSC)
654 CALL CGVEDG(NT,P1,P2,IVIS)
655 IF (IVIS .LT. 0) GOTO 370
656 IF (NFACE .EQ. 0) GOTO 360
657 CALL CGVHED( Q(JCG+JXYZ1),IQ(JCG+JFA),IQ(JCG+JPFA),
658 + Q(JCG+ JDFA),IQ(JCG+JTRE),IQ(JCG+JSTA), Q(JCG+JALE),
661 IF (NPART) 370 ,360 ,340
662 340 DO 350 I=1,NPART+1
663 IF (I .EQ. 1) T1 = 0.
664 IF (I .NE. 1) T1 = TEND(I-1)
665 IF (I .NE. NPART+1) T2 = TSTRT(I)
666 IF (I .EQ. NPART+1) T2 = 1.
667 IF (T2-T1 .LT. TDEL) GOTO 350
668 AX(1) = XA + T1*XDELT
669 AY(1) = YA + T1*YDELT
670 AX(2) = XA + T2*XDELT
671 AY(2) = YA + T2*YDELT
672 IF(LINFIL.GT.1.AND.IDVIEW.NE.0)THEN
674 CALL MVBITS(LINCOL,0,8,LINATT,16)
682 * L I N E I S F U L L Y V I S I B L E
688 IF(LINFIL.GT.1.AND.IDVIEW.NE.0)THEN
690 CALL MVBITS(LINCOL,0,8,LINATT,16)
704 LTY=IBITS(LINATT,10,3)
705 CALL MVBITS(6,0,3,LINATT,10)
706 CALL GDRAWV(TESTX,TESTY,0)
707 CALL MVBITS(LTY,0,3,LINATT,10)
713 10000 FORMAT(' First word of WIRE less or equal 0 ')
714 10100 FORMAT(' N. of words of Hidden Structure less or equal 18 ')