GEANT321/gdraw/gd16v.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:19  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 #if defined(CERNLIB_CG)
  11 *CMZ :  3.21/02 29/03/94  15.41.25  by  S.Giani
  12 *-- Author :
  13       SUBROUTINE GD16V(IWOFFS,SHADE)
  14 ************************************************************************
  15 *                                                                      *
  16 *     Name: GD16V                                                      *
  17 *     Author: S.Giani                            Date:    18.07.91     *
  18 *                                                Revised: 1992         *
  19 *                                                                      *
  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                               *
  24 *               Surface shading                                        *
  25 *                                                                      *
  26 *     References: CGVHED                                               *
  27 *                                                                      *
  28 *     Input: Q(JCG+IWOFFS+*) - WIRE-object                             *
  29 *               Q(JCG+*) - HIDE-structure                              *
  30 *                                                                      *
  31 *     Output: none                                                     *
  32 *                                                                      *
  33 *     Errors: none                                                     *
  34 *                                                                      *
  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"
  48 *
  49       INTEGER SHADE(*)
  50       REAL P1(3),P2(3),AX(2),AY(2)
  51 *SG
  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)
  56 *
  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)
  59 *SG
  60       LLEP=ABS(LEP)
  61 *****                                 CALL IGSET('SYNC',1.)
  62       IF (Q(JCG+IWOFFS+KCGSIZ) .LE. 0.)   THEN
  63          WRITE(CHMAIL,10000)
  64          GOTO 400
  65       ENDIF
  66       IF (Q(JCG+KHSIZE) .LE. LHHEAD)  THEN
  67          WRITE(CHMAIL,10100)
  68          GOTO 400
  69       ENDIF
  70 *SG
  71       LINBUF=0
  72       DO 10  IJ=1,2
  73          TESTX(IJ)=20.
  74          TESTY(IJ)=20.
  75    10 CONTINUE
  76       LINFIL=IBITS(LINATT,13,3)
  77       IF(LINFIL.NE.0)CALL GDRAWV(TESTX,TESTY,-1)
  78       IJKLMN=0
  79       IACTUN=0
  80       LPARZ=0
  81       LFULL=0
  82       IN=0
  83       KKK=0
  84       LMN=0
  85       NSI=0
  86       IGEN=0
  87 *SG
  88       NT = Q(JCG+KHNT)
  89       IF (NT.LE.0 .OR. NT.GT.NTMAX) GOTO 400
  90       NEDGE  = Q(JCG+IWOFFS+KCGNF)
  91 *      IF(NEDGE.EQ.0)GOTO 49
  92       JXYZ1   = Q(JCG+KHJXYZ)
  93       JFA    = Q(JCG+KHJFA)
  94       JPFA   = Q(JCG+KHJPFA)
  95       JDFA   = Q(JCG+KHJDFA)
  96       JTRE   = Q(JCG+KHJTRE)
  97       JSTA   = Q(JCG+KHJSTA)
  98       JALE   = Q(JCG+KHJALE)
  99       JARI   = Q(JCG+KHJARI)
 100       NFACE  = Q(JCG+KHNFAC)
 101       DO 230 NE=1,NEDGE
 102          IF(LINFIL.NE.0)THEN
 103             IF(LLEP.NE.1)THEN
 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)
 108                      ISCFAC(1)=LMN*.5
 109                      DO 20  I=2,LMN+1
 110                         ISCFAC(I)=I-1
 111                         SCXYZ(1,I-1)=CX(I-1)
 112                         SCXYZ(2,I-1)=CY(I-1)
 113                         SCXYZ(3,I-1)=CZ(I-1)
 114    20                CONTINUE
 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)+
 120      +               (COSDIR(3)*ZCOSZ)
 121                      PROSCB=(2.*(PROSCA**2))-1.
 122                      APROSC=PROSCB
 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)
 127                      ELSE
 128                         IF(ISWIT(10).EQ.100)THEN
 129                            PNX=COSDIR(1)
 130                            PNY=COSDIR(2)
 131                            PNZ=COSDIR(3)
 132                            APNZ=ABS(1.-PNZ)
 133                            IF(APNZ.LT..0001)THEN
 134                               AROT(1,1)=1.
 135                               AROT(1,2)=0.
 136                               AROT(1,3)=0.
 137                               AROT(2,1)=0.
 138                               AROT(2,2)=1.
 139                            ELSE
 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)
 145                            ENDIF
 146                            AROT(2,3)=0.
 147                            AROT(3,1)=PNX
 148                            AROT(3,2)=PNY
 149                            AROT(3,3)=PNZ
 150                         ELSE
 151                            DO 40  IHH=1,3
 152                               DO 30  JHH=1,4
 153                                  AROT(IHH,JHH)=TSCRN(JHH,IHH,NT)
 154    30                         CONTINUE
 155    40                      CONTINUE
 156                            AROT(4,1)=0.
 157                            AROT(4,2)=0.
 158                            AROT(4,3)=0.
 159                            AROT(4,4)=1.
 160                         ENDIF
 161                         IF(ISWIT(10).EQ.100)THEN
 162                            ZROT(1,1)=AROT(1,1)
 163                            ZROT(2,1)=AROT(1,2)
 164                            ZROT(3,1)=AROT(1,3)
 165                            ZROT(1,2)=AROT(2,1)
 166                            ZROT(2,2)=AROT(2,2)
 167                            ZROT(3,2)=AROT(2,3)
 168                            ZROT(1,3)=AROT(3,1)
 169                            ZROT(2,3)=AROT(3,2)
 170                            ZROT(3,3)=AROT(3,3)
 171                         ELSE
 172                            DO 60  IHH=1,4
 173                               DO 50  JHH=1,4
 174                                  ZROT(IHH,JHH)=AROT(IHH,JHH)
 175    50                         CONTINUE
 176    60                      CONTINUE
 177                            CALL RINV(4,ZROT,4,RRR,IFAIL)
 178                         ENDIF
 179                         YROTMI=100000.
 180                         YROTMA=-100000.
 181                         DO 70 M=1,LMN
 182                            IF(ISWIT(10).EQ.100)THEN
 183                               CXROT(M)=AROT(1,1)*CX(M)+ AROT(1,2)*CY(M)
 184      +                        +AROT(1,3)*CZ(M)
 185                               CYROT(M)=AROT(2,1)*CX(M)+ AROT(2,2)*CY(M)
 186      +                        +AROT(2,3)*CZ(M)
 187                               CZROT(M)=AROT(3,1)*CX(M)+ AROT(3,2)*CY(M)
 188      +                        +AROT(3,3)*CZ(M)
 189                            ELSE
 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)
 196                            ENDIF
 197                            IF(CYROT(M).LT.YROTMI)YROTMI=CYROT(M)
 198                            IF(CYROT(M).GT.YROTMA)YROTMA=CYROT(M)
 199    70                   CONTINUE
 200                         IF(LINFIL.EQ.1)THEN
 201                            RINULI=.01
 202                         ELSEIF(LINFIL.EQ.2)THEN
 203                            RINULI=.1
 204                         ELSEIF(LINFIL.EQ.3)THEN
 205                            RINULI=.05
 206                         ELSEIF(LINFIL.EQ.4)THEN
 207                            RINULI=.05
 208                         ELSEIF(LINFIL.EQ.5)THEN
 209                            RINULI=.02
 210                         ELSEIF(LINFIL.EQ.6)THEN
 211                            RINULI=.01
 212                         ELSEIF(LINFIL.EQ.7)THEN
 213                            RINULI=.005
 214                         ENDIF
 215                         NYROTM=(YROTMA-YROTMI)/RINULI
 216                         YROTST=YROTMI
 217                         DO 170 MM=1,NYROTM-1
 218                            YROTST=YROTST+RINULI
 219                            JFK=0
 220                            DO 80 MMI=1,LMN-1,2
 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)
 224      +                           ) .GT.YROTST)THEN
 225                                     JFK=JFK+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))
 230      +                           THEN
 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
 235      +                              I)-CZROT(MMI+1))
 236                                     PZINT(JFK)=(YROTST-BBBZ)/AAAZ
 237                                     ENDIF
 238                                  ENDIF
 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)
 242      +                           ) .GT.YROTST)THEN
 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
 247      +                              I)-CXROT(MMI+1))
 248                                     JFK=JFK+1
 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))
 253      +                           THEN
 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
 258      +                              I)-CZROT(MMI+1))
 259                                     PZINT(JFK)=(YROTST-BBBZ)/AAAZ
 260                                     ENDIF
 261                                  ENDIF
 262                               ENDIF
 263    80                      CONTINUE
 264                            DO 100 JM=1,JFK-1
 265                               DO 90 KM=JM+1,JFK
 266                                  IF(PXINT(JM).LT.PXINT(KM))THEN
 267                                     TMPM=PXINT(JM)
 268                                     TMPZ=PZINT(JM)
 269                                     PXINT(JM)=PXINT(KM)
 270                                     PZINT(JM)=PZINT(KM)
 271                                     PXINT(KM)=TMPM
 272                                     PZINT(KM)=TMPZ
 273                                  ENDIF
 274    90                         CONTINUE
 275   100                      CONTINUE
 276                            RJFK=JFK*.5
 277                            IRJFK=RJFK
 278 *                          IF((RJFK-IRJFK).GT..1)PRINT *,'Odd !'
 279                            DO 110 MR=1,JFK
 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)
 287                               ELSE
 288                                  XPINT(MR)=ZROT(1,4)+ZROT(1,1)*
 289      +                           PXINT(MR)+ ZROT(1,2)*YROTST+ZROT(1,3)*
 290      +                           PZINT(MR)
 291                                  YPINT(MR)=ZROT(2,4)+ZROT(2,1)*
 292      +                           PXINT(MR)+ ZROT(2,2)*YROTST+ZROT(2,3)*
 293      +                           PZINT(MR)
 294                                  ZPINT(MR)=ZROT(3,4)+ZROT(3,1)*
 295      +                           PXINT(MR)+ ZROT(3,2)*YROTST+ZROT(3,3)*
 296      +                           PZINT(MR)
 297                               ENDIF
 298   110                      CONTINUE
 299                            IF(LINFIL.GT.1)THEN
 300                               LINCOL=IBITS(LINATT,16,8)
 301                               CALL GDSHAD(LINCOL,APROSC)
 302                            ENDIF
 303                            DO 160 MZ=1,JFK,2
 304                               P1(1)=XPINT(MZ)
 305                               P1(2)=YPINT(MZ)
 306                               P1(3)=ZPINT(MZ)
 307                               P2(1)=XPINT(MZ+1)
 308                               P2(2)=YPINT(MZ+1)
 309                               P2(3)=ZPINT(MZ+1)
 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))
 316 *           D R A W   E D G E
 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
 329                                     LLLINA=LINATT
 330                                     CALL MVBITS(LINCOL,0,8,LINATT,16)
 331                                     CALL GDRAWV(AX,AY,2)
 332                                     LINATT=LLLINA
 333                                  ELSE
 334                                     CALL GDRAWV(AX,AY,2)
 335                                  ENDIF
 336   130                         CONTINUE
 337                               GOTO 150
 338 *           L I N E   I S   F U L L Y   V I S I B L E
 339   140                         CONTINUE
 340                               AX(1) = AA(1)
 341                               AY(1) = AA(2)
 342                               AX(2) = BB(1)
 343                               AY(2) = BB(2)
 344                               IF(LINFIL.GT.1.AND.IDVIEW.NE.0)THEN
 345                                  LLLINA=LINATT
 346                                  CALL MVBITS(LINCOL,0,8,LINATT,16)
 347                                  CALL GDRAWV(AX,AY,2)
 348                                  LINATT=LLLINA
 349                               ELSE
 350                                  CALL GDRAWV(AX,AY,2)
 351                               ENDIF
 352   150                         CONTINUE
 353   160                      CONTINUE
 354   170                   CONTINUE
 355                      ENDIF
 356 *  Resetting counters for next face
 357                      IJKLMN=0
 358                      LPARZ=0
 359                      LFULL=0
 360                      IN=0
 361                      KKK=0
 362                      LMN=0
 363                      NSI=0
 364                      IGEN=0
 365                      GOTO 190
 366                   ENDIF
 367   180          CONTINUE
 368             ENDIF
 369          ENDIF
 370   190    CONTINUE
 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)
 379          IF(LINFIL.NE.0)THEN
 380             LMN=LMN+1
 381 *          IF(LMN.GE.500)THEN
 382 *            PRINT *,LMN,'=LMN'
 383 *          ENDIF
 384             CX(LMN)=P1(1)
 385             CY(LMN)=P1(2)
 386             CZ(LMN)=P1(3)
 387             LMN=LMN+1
 388 *          IF(LMN.GE.500)THEN
 389 *            PRINT *,LMN,'=LMN'
 390 *          ENDIF
 391             CX(LMN)=P2(1)
 392             CY(LMN)=P2(2)
 393             CZ(LMN)=P2(3)
 394          ENDIF
 395          CALL CGVEDG(NT,P1,P2,IVIS)
 396          IF(LINFIL.NE.0)THEN
 397             IJKLMN=IJKLMN+1
 398 *              IF(IJKLMN.GE.500)THEN
 399 *                PRINT *,IJKLMN,'=IJKLMN'
 400 *              ENDIF
 401             VVX(IJKLMN)=AA(1)
 402             VVY(IJKLMN)=AA(2)
 403             IJKLMN=IJKLMN+1
 404 *              IF(IJKLMN.GE.500)THEN
 405 *                PRINT *,IJKLMN,'=IJKLMN'
 406 *              ENDIF
 407             VVX(IJKLMN)=BB(1)
 408             VVY(IJKLMN)=BB(2)
 409          ENDIF
 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))
 414 *           D R A W   E D G E
 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
 426             IF(LINFIL.NE.0)THEN
 427                LTY=IBITS(LINATT,10,3)
 428                CALL MVBITS(6,0,3,LINATT,10)
 429 ***               IOLEP=LEP
 430 ***               LEP=11
 431                CALL GDRAWV(AX,AY,2)
 432 ***               LEP=IOLEP
 433                CALL MVBITS(LTY,0,3,LINATT,10)
 434             ELSE
 435                CALL GDRAWV(AX,AY,2)
 436             ENDIF
 437   210    CONTINUE
 438          LPARZ=LPARZ+1
 439          GOTO 230
 440 *           L I N E   I S   F U L L Y   V I S I B L E
 441   220    CONTINUE
 442          AX(1) = AA(1)
 443          AY(1) = AA(2)
 444          AX(2) = BB(1)
 445          AY(2) = BB(2)
 446          IF(LINFIL.NE.0)THEN
 447             LTY=IBITS(LINATT,10,3)
 448             CALL MVBITS(6,0,3,LINATT,10)
 449 ***            IOLEP=LEP
 450 ***            LEP=11
 451             CALL GDRAWV(AX,AY,2)
 452 ***            LEP=IOLEP
 453             CALL MVBITS(LTY,0,3,LINATT,10)
 454          ELSE
 455             CALL GDRAWV(AX,AY,2)
 456          ENDIF
 457          LFULL=LFULL+1
 458   230 CONTINUE
 459 *SG
 460       IF(LINFIL.NE.0)THEN
 461 ***         IF((LFULL+LPARZ).EQ.0)GOTO 555
 462          CALL CGFAC2(CX,CY,CZ,LMN)
 463          ISCFAC(1)=LMN*.5
 464          DO 240  I=2,LMN+1
 465             ISCFAC(I)=I-1
 466             SCXYZ(1,I-1)=CX(I-1)
 467             SCXYZ(2,I-1)=CY(I-1)
 468             SCXYZ(3,I-1)=CZ(I-1)
 469   240    CONTINUE
 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.
 476          APROSC=PROSCB
 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)
 481          ELSE
 482             IF(ISWIT(10).EQ.100)THEN
 483                PNX=COSDIR(1)
 484                PNY=COSDIR(2)
 485                PNZ=COSDIR(3)
 486                APNZ=ABS(1.-PNZ)
 487                IF(APNZ.LT..0001)THEN
 488                   AROT(1,1)=1.
 489                   AROT(1,2)=0.
 490                   AROT(1,3)=0.
 491                   AROT(2,1)=0.
 492                   AROT(2,2)=1.
 493                ELSE
 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)
 499                ENDIF
 500                AROT(2,3)=0.
 501                AROT(3,1)=PNX
 502                AROT(3,2)=PNY
 503                AROT(3,3)=PNZ
 504             ELSE
 505                DO 260 IHH=1,3
 506                   DO 250 JHH=1,4
 507                      AROT(IHH,JHH)=TSCRN(JHH,IHH,NT)
 508   250             CONTINUE
 509   260          CONTINUE
 510                AROT(4,1)=0.
 511                AROT(4,2)=0.
 512                AROT(4,3)=0.
 513                AROT(4,4)=1.
 514             ENDIF
 515             IF(ISWIT(10).EQ.100)THEN
 516                ZROT(1,1)=AROT(1,1)
 517                ZROT(2,1)=AROT(1,2)
 518                ZROT(3,1)=AROT(1,3)
 519                ZROT(1,2)=AROT(2,1)
 520                ZROT(2,2)=AROT(2,2)
 521                ZROT(3,2)=AROT(2,3)
 522                ZROT(1,3)=AROT(3,1)
 523                ZROT(2,3)=AROT(3,2)
 524                ZROT(3,3)=AROT(3,3)
 525             ELSE
 526                DO 280 IHH=1,4
 527                   DO 270 JHH=1,4
 528                      ZROT(IHH,JHH)=AROT(IHH,JHH)
 529   270             CONTINUE
 530   280          CONTINUE
 531                CALL RINV(4,ZROT,4,RRR,IFAIL)
 532             ENDIF
 533             YROTMI=100000.
 534             YROTMA=-100000.
 535             DO 290 M=1,LMN
 536                IF(ISWIT(10).EQ.100)THEN
 537                   CXROT(M)=AROT(1,1)*CX(M)+ AROT(1,2)*CY(M)+AROT(1,3)*
 538      +            CZ(M)
 539                   CYROT(M)=AROT(2,1)*CX(M)+ AROT(2,2)*CY(M)+AROT(2,3)*
 540      +            CZ(M)
 541                   CZROT(M)=AROT(3,1)*CX(M)+ AROT(3,2)*CY(M)+AROT(3,3)*
 542      +            CZ(M)
 543                ELSE
 544                   CXROT(M)=AROT(1,4)+AROT(1,1)*CX(M)+ AROT(1,2)*CY(M)+
 545      +            AROT(1,3)*CZ(M)
 546                   CYROT(M)=AROT(2,4)+AROT(2,1)*CX(M)+ AROT(2,2)*CY(M)+
 547      +            AROT(2,3)*CZ(M)
 548                   CZROT(M)=AROT(3,4)+AROT(3,1)*CX(M)+ AROT(3,2)*CY(M)+
 549      +            AROT(3,3)*CZ(M)
 550                ENDIF
 551                IF(CYROT(M).LT.YROTMI)YROTMI=CYROT(M)
 552                IF(CYROT(M).GT.YROTMA)YROTMA=CYROT(M)
 553   290       CONTINUE
 554             IF(LINFIL.EQ.1)THEN
 555                RINULI=.01
 556             ELSEIF(LINFIL.EQ.2)THEN
 557                RINULI=.1
 558             ELSEIF(LINFIL.EQ.3)THEN
 559                RINULI=.05
 560             ELSEIF(LINFIL.EQ.4)THEN
 561                RINULI=.05
 562             ELSEIF(LINFIL.EQ.5)THEN
 563                RINULI=.02
 564             ELSEIF(LINFIL.EQ.6)THEN
 565                RINULI=.01
 566             ELSEIF(LINFIL.EQ.7)THEN
 567                RINULI=.005
 568             ENDIF
 569             NYROTM=(YROTMA-YROTMI)/RINULI
 570             YROTST=YROTMI
 571             DO 390 MM=1,NYROTM-1
 572                YROTST=YROTST+RINULI
 573                JFK=0
 574                DO 300 MMI=1,LMN-1,2
 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
 578                         JFK=JFK+1
 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)-
 584      +                     CZROT(MMI+1))
 585                            BBBZ=(CZROT(MMI)*CYROT(MMI+1)- CYROT(MMI)*
 586      +                     CZROT(MMI+1))/ (CZROT(MMI)-CZROT(MMI+1))
 587                            PZINT(JFK)=(YROTST-BBBZ)/AAAZ
 588                         ENDIF
 589                      ENDIF
 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)-
 594      +                  CXROT(MMI+1))
 595                         BBB=(CXROT(MMI)*CYROT(MMI+1)- CYROT(MMI)*
 596      +                  CXROT(MMI+1))/ (CXROT(MMI)-CXROT(MMI+1))
 597                         JFK=JFK+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)-
 603      +                     CZROT(MMI+1))
 604                            BBBZ=(CZROT(MMI)*CYROT(MMI+1)- CYROT(MMI)*
 605      +                     CZROT(MMI+1))/ (CZROT(MMI)-CZROT(MMI+1))
 606                            PZINT(JFK)=(YROTST-BBBZ)/AAAZ
 607                         ENDIF
 608                      ENDIF
 609                   ENDIF
 610   300          CONTINUE
 611                DO 320 JM=1,JFK-1
 612                   DO 310 KM=JM+1,JFK
 613                      IF(PXINT(JM).LT.PXINT(KM))THEN
 614                         TMPM=PXINT(JM)
 615                         TMPZ=PZINT(JM)
 616                         PXINT(JM)=PXINT(KM)
 617                         PZINT(JM)=PZINT(KM)
 618                         PXINT(KM)=TMPM
 619                         PZINT(KM)=TMPZ
 620                      ENDIF
 621   310             CONTINUE
 622   320          CONTINUE
 623                RJFK=JFK*.5
 624                IRJFK=RJFK
 625 *              IF((RJFK-IRJFK).GT..1)PRINT *,'Odd !'
 626                DO 330 MR=1,JFK
 627                   IF(ISWIT(10).EQ.100)THEN
 628                      XPINT(MR)=ZROT(1,1)*PXINT(MR)+ ZROT(1,2)*YROTST+
 629      +               ZROT(1,3)*CZROT(1)
 630                      YPINT(MR)=ZROT(2,1)*PXINT(MR)+ ZROT(2,2)*YROTST+
 631      +               ZROT(2,3)*CZROT(1)
 632                      ZPINT(MR)=ZROT(3,1)*PXINT(MR)+ ZROT(3,2)*YROTST+
 633      +               ZROT(3,3)*CZROT(1)
 634                   ELSE
 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)
 641                   ENDIF
 642   330          CONTINUE
 643                IF(LINFIL.GT.1)THEN
 644                   LINCOL=IBITS(LINATT,16,8)
 645                   CALL GDSHAD(LINCOL,APROSC)
 646                ENDIF
 647                DO 380 MZ=1,JFK,2
 648                   P1(1)=XPINT(MZ)
 649                   P1(2)=YPINT(MZ)
 650                   P1(3)=ZPINT(MZ)
 651                   P2(1)=XPINT(MZ+1)
 652                   P2(2)=YPINT(MZ+1)
 653                   P2(3)=ZPINT(MZ+1)
 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),
 659      +            Q(JCG+JARI))
 660 *           D R A W   E D G E
 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
 673                         LLLINA=LINATT
 674                         CALL MVBITS(LINCOL,0,8,LINATT,16)
 675                         CALL GDRAWV(AX,AY,2)
 676                         LINATT=LLLINA
 677                      ELSE
 678                         CALL GDRAWV(AX,AY,2)
 679                      ENDIF
 680   350             CONTINUE
 681                   GOTO 370
 682 *           L I N E   I S   F U L L Y   V I S I B L E
 683   360             CONTINUE
 684                   AX(1) = AA(1)
 685                   AY(1) = AA(2)
 686                   AX(2) = BB(1)
 687                   AY(2) = BB(2)
 688                   IF(LINFIL.GT.1.AND.IDVIEW.NE.0)THEN
 689                      LLLINA=LINATT
 690                      CALL MVBITS(LINCOL,0,8,LINATT,16)
 691                      CALL GDRAWV(AX,AY,2)
 692                      LINATT=LLLINA
 693                   ELSE
 694                      CALL GDRAWV(AX,AY,2)
 695                   ENDIF
 696   370             CONTINUE
 697   380          CONTINUE
 698   390       CONTINUE
 699          ENDIF
 700       ENDIF
 701 ***      IOLEP=LEP
 702 ***      LEP=11
 703       IF(LINFIL.NE.0)THEN
 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)
 708 ***      LEP=IOLEP
 709       ENDIF
 710 *SG
 711   400 RETURN
 712 *
 713 10000    FORMAT('  First word of WIRE less or equal 0 ')
 714 10100    FORMAT(' N. of words of Hidden Structure less or equal 18 ')
 715 *
 716       END
 717 #endif