C
C $Id: tddtri.f,v 1.4 2008-07-27 00:17:32 haley Exp $
C                                                                      
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE TDDTRI (RTRI,MTRI,NTRI,ITWK)
C
        DIMENSION RTRI(10,MTRI),ITWK(NTRI)
C
C The routine TDDTRI is called to draw triangles that have previously
C been generated by calls to the routines TDSTRI and/or TDITRI (or in
C some other way) and ordered by a call to the routine TDOTRI (or in
C some other way).  Its arguments are as follows:
C
C   RTRI is a real array in which a list of triangles has been
C   generated; it is dimensioned 10 x MTRI.  Each 10-word entry in
C   the list consists of the U, V, and W coordinates of each of three
C   points, followed by a rendering style index.
C
C   MTRI is an input integer specifying the second dimension of the
C   array RTRI: the maximum number of triangles the list will hold.
C
C   NTRI is an input integer specifying the number of triangles in the
C   array RTRI.  Initially, NTRI must be zeroed by the user.  Each call
C   to one of the routines TDSTRI or TDITRI updates the value of NTRI
C   to reflect the number of triangles added to the list.
C
C   ITWK is an integer input array, dimensioned at least NTRI, in
C   which has been stored a permutation of the integers from 1 to NTRI.
C   The triangles will be rendered in the order specified by this array.
C   One possible way of setting the contents of ITWK is to call the
C   routine TDOTRI.
C
C Declare required TDPACK common blocks.
C
        COMMON /TDCOM1/ IH,IT,XM,YM,ZM,XO,YO,ZO,XT,YT,ZT,OE,XE,YE,ZE
        COMMON /TDCOM1/ A1,B1,C1,D1,E1,A2,B2,C2,D2,E2,A3,B3,C3,D3,E3
        COMMON /TDCOM1/ IS,FV,VL,VR,VB,VT,WL,WR,WB,WT
        SAVE   /TDCOM1/
C
        COMMON /TDCOM3/ IFC1(64),IFC2(64),IFC3(64),IFC4(64),ILC1(64)
        COMMON /TDCOM3/ ILC2(64),ILTD(64),USTP(64),VSTP(64),WSTP(64)
        SAVE   /TDCOM3/
C
        COMMON /TDCOM6/ ISHD,XPLS,YPLS,ZPLS
        SAVE   /TDCOM6/
C
C Declare some arrays to use in drawing/filling triangles.
C
        DIMENSION X(3),Y(3)
C
C Declare the radians-to-degrees conversion constant.
C
        DATA RTOD / 57.2957795130823 /
C
C Declare arithmetic statement functions that are used in the code that
C determines the line of intersection of a triangle with a slice in one
C of the three coordinate directions.
C
        FIN1(R,J,K)=(R              -RTRI(J,ITWK(I)))/
     +              (RTRI(K,ITWK(I))-RTRI(J,ITWK(I)))
C
        FIN2(T,J,K)=RTRI(J,ITWK(I))+T*(RTRI(K,ITWK(I))-RTRI(J,ITWK(I)))
C
C Declare an arithmetic statement function that can be used to tell
C whether the vertices of a triangle are given in clockwise order or
C counterclockwise order.
C
        VPDT(U1,V1,U2,V2,U3,V3)=(U1-U3)*(V2-V3)-(V1-V3)*(U2-U3)
C
C Initialize fill-color and line-color controls.
C
        CALL GQPLCI (IERR,ILCS)
        ILCC=ILCS
        CALL GQFACI (IERR,IFCS)
        IFCC=IFCS
C
C Deal with the triangles one at a time.
C
        DO 105 I=1,NTRI
C
C Pull out the rendering style for the triangle.
C
          IRST=MAX(1,MIN(64,INT(RTRI(10,ITWK(I)))))
C
C If the values will be needed, project the vertices of the triangle
C and then determine which side we're looking at the triangle from.
C
          IF (IFC1(IRST).GE.0.OR.IFC3(IRST).GE.0.OR.
     +        ILC1(IRST).GE.0.OR.ILC2(IRST).GE.0) THEN
            CALL TDPRPT (RTRI(1,ITWK(I)),
     +                   RTRI(2,ITWK(I)),
     +                   RTRI(3,ITWK(I)),
     +                         X(1),Y(1))
            CALL TDPRPT (RTRI(4,ITWK(I)),
     +                   RTRI(5,ITWK(I)),
     +                   RTRI(6,ITWK(I)),
     +                         X(2),Y(2))
            CALL TDPRPT (RTRI(7,ITWK(I)),
     +                   RTRI(8,ITWK(I)),
     +                   RTRI(9,ITWK(I)),
     +                         X(3),Y(3))
            SIDE=SIGN(1.,VPDT(X(1),Y(1),X(2),Y(2),X(3),Y(3)))
            IF (IH.NE.0) SIDE=-SIDE
          END IF
C
C Determine whether or not the triangle is to be filled and, if so, in
C what color.  (The most complicated possibility is that the triangle
C is to be filled in a color depending on the angle between its normal
C and the line from its center to the specified position of the light
C source.)
C
          IF ((IFC1(IRST).GE.0.AND.IFC2(IRST).GT.IFC1(IRST).AND.
     +                                                SIDE.LT.0.).OR.
     +        (IFC3(IRST).GE.0.AND.IFC4(IRST).GT.IFC3(IRST).AND.
     +                                                SIDE.GE.0.)) THEN
            UDN1=RTRI(2,ITWK(I))*(RTRI(9,ITWK(I))-RTRI(6,ITWK(I)))+
     +           RTRI(5,ITWK(I))*(RTRI(3,ITWK(I))-RTRI(9,ITWK(I)))+
     +           RTRI(8,ITWK(I))*(RTRI(6,ITWK(I))-RTRI(3,ITWK(I)))
            VDN1=RTRI(1,ITWK(I))*(RTRI(6,ITWK(I))-RTRI(9,ITWK(I)))+
     +           RTRI(4,ITWK(I))*(RTRI(9,ITWK(I))-RTRI(3,ITWK(I)))+
     +           RTRI(7,ITWK(I))*(RTRI(3,ITWK(I))-RTRI(6,ITWK(I)))
            WDN1=RTRI(1,ITWK(I))*(RTRI(8,ITWK(I))-RTRI(5,ITWK(I)))+
     +           RTRI(4,ITWK(I))*(RTRI(2,ITWK(I))-RTRI(8,ITWK(I)))+
     +           RTRI(7,ITWK(I))*(RTRI(5,ITWK(I))-RTRI(2,ITWK(I)))
            IF (XPLS.EQ.0..AND.YPLS.EQ.0..AND.ZPLS.EQ.0.) THEN
              UDN2=XM  -(RTRI(1,ITWK(I))+RTRI(4,ITWK(I))+
     +                                   RTRI(7,ITWK(I)))/3.
              VDN2=YM  -(RTRI(2,ITWK(I))+RTRI(5,ITWK(I))+
     +                                   RTRI(8,ITWK(I)))/3.
              WDN2=ZM  -(RTRI(3,ITWK(I))+RTRI(6,ITWK(I))+
     +                                   RTRI(9,ITWK(I)))/3.
            ELSE
              UDN2=XPLS-(RTRI(1,ITWK(I))+RTRI(4,ITWK(I))+
     +                                   RTRI(7,ITWK(I)))/3.
              VDN2=YPLS-(RTRI(2,ITWK(I))+RTRI(5,ITWK(I))+
     +                                   RTRI(8,ITWK(I)))/3.
              WDN2=ZPLS-(RTRI(3,ITWK(I))+RTRI(6,ITWK(I))+
     +                                   RTRI(9,ITWK(I)))/3.
            END IF
            IF (UDN1.NE.0..OR.VDN1.NE.0..OR.WDN1.NE.0.) THEN
              ANGD=RTOD*ABS(ACOS(-SIDE*(UDN1*UDN2+VDN1*VDN2+WDN1*WDN2)/
     +                            SQRT((UDN1*UDN1+VDN1*VDN1+WDN1*WDN1)*
     +                                 (UDN2*UDN2+VDN2*VDN2+WDN2*WDN2))
     +                                                                ))
            ELSE
              ANGD=90.
            END IF
            IF (ISHD.EQ.0) THEN
              IF (ANGD.GT.90.) ANGD=180.-ANGD
              IF (SIDE.LT.0.) THEN
                IFCD=MAX(IFC1(IRST),MIN(IFC2(IRST),
     +               IFC1(IRST)+INT(ANGD/(90./REAL(IFC2(IRST)-
     +                                             IFC1(IRST)+1)))))
              ELSE
                IFCD=MAX(IFC3(IRST),MIN(IFC4(IRST),
     +               IFC3(IRST)+INT(ANGD/(90./REAL(IFC4(IRST)-
     +                                             IFC3(IRST)+1)))))
              END IF
            ELSE
              IF (SIDE.LT.0.) THEN
                IFCD=MAX(IFC1(IRST),MIN(IFC2(IRST),
     +               IFC1(IRST)+INT(ANGD/(180./REAL(IFC2(IRST)-
     +                                              IFC1(IRST)+1)))))
              ELSE
                IFCD=MAX(IFC3(IRST),MIN(IFC4(IRST),
     +               IFC3(IRST)+INT(ANGD/(180./REAL(IFC4(IRST)-
     +                                              IFC3(IRST)+1)))))
              END IF
            END IF
          ELSE IF (SIDE.LT.0..AND.IFC1(IRST).GE.0) THEN
            IFCD=IFC1(IRST)
          ELSE IF (SIDE.GE.0..AND.IFC3(IRST).GE.0) THEN
            IFCD=IFC3(IRST)
          ELSE
            IFCD=-1
          END IF
C
C If the fill color desired is different from the current fill color,
C reset the latter.
C
          IF (IFCD.GE.0.AND.IFCC.NE.IFCD) THEN
            CALL GSFACI (IFCD)
            IFCC=IFCD
          END IF
C
C If appropriate, fill the triangle.
C
          IF (IFCD.GE.0) CALL GFA (3,X,Y)
C
C Determine whether or not any lines are to be drawn in the triangle
C and, if so, set the desired color index.
C
          IF (SIDE.LT.0..AND.ILC1(IRST).GE.0) THEN
            ILCD=ILC1(IRST)
          ELSE IF (SIDE.GE.0..AND.ILC2(IRST).GE.0) THEN
            ILCD=ILC2(IRST)
          ELSE
            ILCD=-1
          END IF
C
C If the desired line color is different from the current line color,
C reset the latter.
C
          IF (ILCD.GE.0.AND.ILCC.NE.ILCD) THEN
            CALL PLOTIF (0.,0.,2)
            CALL GSPLCI (ILCD)
            ILCC=ILCD
          END IF
C
C If the triangle outline is to be drawn, do that.
C
          IF (ILCD.GE.0.AND.ILTD(IRST).NE.0) THEN
            CALL LINE (X(1),Y(1),X(2),Y(2))
            CALL LINE (X(2),Y(2),X(3),Y(3))
            CALL LINE (X(3),Y(3),X(1),Y(1))
          END IF
C
C If U slices are do be drawn, do that.
C
          IF (ILCD.GE.0.AND.USTP(IRST).GT.0.) THEN
            UMIN=MIN(RTRI(1,ITWK(I)),RTRI(4,ITWK(I)),RTRI(7,ITWK(I)))
            UMAX=MAX(RTRI(1,ITWK(I)),RTRI(4,ITWK(I)),RTRI(7,ITWK(I)))
            IF (UMIN.NE.UMAX) THEN
              UEPS=1.E-3*(UMAX-UMIN)
              IST1=INT((UMIN-UEPS)/USTP(IRST)+.5+SIGN(.5,UMIN-UEPS))
              IST2=INT((UMAX+UEPS)/USTP(IRST)-.5+SIGN(.5,UMAX+UEPS))
              DO 102 ISTP=IST1,IST2
                UVAL=REAL(ISTP)*USTP(IRST)
                IF (RTRI(1,ITWK(I)).NE.RTRI(4,ITWK(I))) THEN
                  T12=FIN1(UVAL,1,4)
                ELSE
                  T12=-1.
                END IF
                IF (RTRI(4,ITWK(I)).NE.RTRI(7,ITWK(I))) THEN
                  T23=FIN1(UVAL,4,7)
                ELSE
                  T23=-1.
                END IF
                IF (RTRI(7,ITWK(I)).NE.RTRI(1,ITWK(I))) THEN
                  T31=FIN1(UVAL,7,1)
                ELSE
                  T31=-1.
                END IF
                IF (UMIN.EQ.MIN(RTRI(1,ITWK(I)),RTRI(4,ITWK(I))).AND.
     +              UMAX.EQ.MAX(RTRI(1,ITWK(I)),RTRI(4,ITWK(I)))) THEN
                  IF (T23.GE.-.001.AND.T23.LE.1.001) THEN
                    CALL TDLINE (UVAL,FIN2(T12,2,5),FIN2(T12,3,6),
     +                           UVAL,FIN2(T23,5,8),FIN2(T23,6,9))
                  ELSE IF (T31.GE.-.001.AND.T31.LE.1.001) THEN
                    CALL TDLINE (UVAL,FIN2(T12,2,5),FIN2(T12,3,6),
     +                           UVAL,FIN2(T31,8,2),FIN2(T31,9,3))
                  END IF
                ELSE
     +          IF (UMIN.EQ.MIN(RTRI(4,ITWK(I)),RTRI(7,ITWK(I))).AND.
     +              UMAX.EQ.MAX(RTRI(4,ITWK(I)),RTRI(7,ITWK(I))))THEN
                  IF (T31.GE.-.001.AND.T31.LE.1.001) THEN
                    CALL TDLINE (UVAL,FIN2(T23,5,8),FIN2(T23,6,9),
     +                           UVAL,FIN2(T31,8,2),FIN2(T31,9,3))
                  ELSE IF (T12.GE.-.001.AND.T12.LE.1.001) THEN
                    CALL TDLINE (UVAL,FIN2(T12,2,5),FIN2(T12,3,6),
     +                           UVAL,FIN2(T23,5,8),FIN2(T23,6,9))
                  END IF
                ELSE
                  IF (T12.GE.-.001.AND.T12.LE.1.001) THEN
                    CALL TDLINE (UVAL,FIN2(T12,2,5),FIN2(T12,3,6),
     +                           UVAL,FIN2(T31,8,2),FIN2(T31,9,3))
                  ELSE IF (T23.GE.-.001.AND.T23.LE.1.001) THEN
                    CALL TDLINE (UVAL,FIN2(T23,5,8),FIN2(T23,6,9),
     +                           UVAL,FIN2(T31,8,2),FIN2(T31,9,3))
                  END IF
                END IF
  102         CONTINUE
            END IF
          END IF
C
C If V slices are do be drawn, do that.
C
          IF (ILCD.GE.0.AND.VSTP(IRST).GT.0.) THEN
            VMIN=MIN(RTRI(2,ITWK(I)),RTRI(5,ITWK(I)),RTRI(8,ITWK(I)))
            VMAX=MAX(RTRI(2,ITWK(I)),RTRI(5,ITWK(I)),RTRI(8,ITWK(I)))
            IF (VMIN.NE.VMAX) THEN
              VEPS=1.E-3*(VMAX-VMIN)
              IST1=INT((VMIN-VEPS)/VSTP(IRST)+.5+SIGN(.5,VMIN-VEPS))
              IST2=INT((VMAX+VEPS)/VSTP(IRST)-.5+SIGN(.5,VMAX+VEPS))
              DO 103 ISTP=IST1,IST2
                VVAL=REAL(ISTP)*VSTP(IRST)
                IF (RTRI(2,ITWK(I)).NE.RTRI(5,ITWK(I))) THEN
                  T12=FIN1(VVAL,2,5)
                ELSE
                  T12=-1.
                END IF
                IF (RTRI(5,ITWK(I)).NE.RTRI(8,ITWK(I))) THEN
                  T23=FIN1(VVAL,5,8)
                ELSE
                  T23=-1.
                END IF
                IF (RTRI(8,ITWK(I)).NE.RTRI(2,ITWK(I))) THEN
                  T31=FIN1(VVAL,8,2)
                ELSE
                  T31=-1.
                END IF
                IF (VMIN.EQ.MIN(RTRI(2,ITWK(I)),RTRI(5,ITWK(I))).AND.
     +              VMAX.EQ.MAX(RTRI(2,ITWK(I)),RTRI(5,ITWK(I)))) THEN
                  IF (T23.GE.-.001.AND.T23.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),VVAL,FIN2(T12,3,6),
     +                           FIN2(T23,4,7),VVAL,FIN2(T23,6,9))
                  ELSE IF (T31.GE.-.001.AND.T31.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),VVAL,FIN2(T12,3,6),
     +                           FIN2(T31,7,1),VVAL,FIN2(T31,9,3))
                  END IF
                ELSE
     +          IF (VMIN.EQ.MIN(RTRI(5,ITWK(I)),RTRI(8,ITWK(I))).AND.
     +              VMAX.EQ.MAX(RTRI(5,ITWK(I)),RTRI(8,ITWK(I))))THEN
                  IF (T31.GE.-.001.AND.T31.LE.1.001) THEN
                    CALL TDLINE (FIN2(T23,4,7),VVAL,FIN2(T23,6,9),
     +                           FIN2(T31,7,1),VVAL,FIN2(T31,9,3))
                  ELSE IF (T12.GE.-.001.AND.T12.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),VVAL,FIN2(T12,3,6),
     +                           FIN2(T23,4,7),VVAL,FIN2(T23,6,9))
                  END IF
                ELSE
                  IF (T12.GE.-.001.AND.T12.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),VVAL,FIN2(T12,3,6),
     +                           FIN2(T31,7,1),VVAL,FIN2(T31,9,3))
                  ELSE IF (T23.GE.-.001.AND.T23.LE.1.001) THEN
                    CALL TDLINE (FIN2(T23,4,7),VVAL,FIN2(T23,6,9),
     +                           FIN2(T31,7,1),VVAL,FIN2(T31,9,3))
                  END IF
                END IF
  103         CONTINUE
            END IF
          END IF
C
C If W slices are do be drawn, do that.
C
          IF (ILCD.GE.0.AND.WSTP(IRST).GT.0.) THEN
            WMIN=MIN(RTRI(3,ITWK(I)),RTRI(6,ITWK(I)),RTRI(9,ITWK(I)))
            WMAX=MAX(RTRI(3,ITWK(I)),RTRI(6,ITWK(I)),RTRI(9,ITWK(I)))
            IF (WMIN.NE.WMAX) THEN
              WEPS=1.E-3*(WMAX-WMIN)
              IST1=INT((WMIN-WEPS)/WSTP(IRST)+.5+SIGN(.5,WMIN-WEPS))
              IST2=INT((WMAX+WEPS)/WSTP(IRST)-.5+SIGN(.5,WMAX+WEPS))
              DO 104 ISTP=IST1,IST2
                WVAL=REAL(ISTP)*WSTP(IRST)
                IF (RTRI(3,ITWK(I)).NE.RTRI(6,ITWK(I))) THEN
                  T12=FIN1(WVAL,3,6)
                ELSE
                  T12=-1.
                END IF
                IF (RTRI(6,ITWK(I)).NE.RTRI(9,ITWK(I))) THEN
                  T23=FIN1(WVAL,6,9)
                ELSE
                  T23=-1.
                END IF
                IF (RTRI(9,ITWK(I)).NE.RTRI(3,ITWK(I))) THEN
                  T31=FIN1(WVAL,9,3)
                ELSE
                  T31=-1.
                END IF
                IF (WMIN.EQ.MIN(RTRI(3,ITWK(I)),RTRI(6,ITWK(I))).AND.
     +              WMAX.EQ.MAX(RTRI(3,ITWK(I)),RTRI(6,ITWK(I)))) THEN
                  IF (T23.GE.-.001.AND.T23.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),FIN2(T12,2,5),WVAL,
     +                           FIN2(T23,4,7),FIN2(T23,5,8),WVAL)
                  ELSE IF (T31.GE.-.001.AND.T31.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),FIN2(T12,2,5),WVAL,
     +                           FIN2(T31,7,1),FIN2(T31,8,2),WVAL)
                  END IF
                ELSE
     +          IF (WMIN.EQ.MIN(RTRI(6,ITWK(I)),RTRI(9,ITWK(I))).AND.
     +              WMAX.EQ.MAX(RTRI(6,ITWK(I)),RTRI(9,ITWK(I))))THEN
                  IF (T31.GE.-.001.AND.T31.LE.1.001) THEN
                    CALL TDLINE (FIN2(T23,4,7),FIN2(T23,5,8),WVAL,
     +                           FIN2(T31,7,1),FIN2(T31,8,2),WVAL)
                  ELSE IF (T12.GE.-.001.AND.T12.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),FIN2(T12,2,5),WVAL,
     +                           FIN2(T23,4,7),FIN2(T23,5,8),WVAL)
                  END IF
                ELSE
                  IF (T12.GE.-.001.AND.T12.LE.1.001) THEN
                    CALL TDLINE (FIN2(T12,1,4),FIN2(T12,2,5),WVAL,
     +                           FIN2(T31,7,1),FIN2(T31,8,2),WVAL)
                  ELSE IF (T23.GE.-.001.AND.T23.LE.1.001) THEN
                    CALL TDLINE (FIN2(T23,4,7),FIN2(T23,5,8),WVAL,
     +                           FIN2(T31,7,1),FIN2(T31,8,2),WVAL)
                  END IF
                END IF
  104         CONTINUE
            END IF
          END IF
C
  105   CONTINUE
C
C Restore entry values of fill and polyline color indices.
C
        IF (ILCC.NE.ILCS) THEN
          CALL PLOTIF (0.,0.,2)
          CALL GSPLCI (ILCS)
        END IF
C
        IF (IFCC.NE.IFCS) CALL GSFACI (IFCS)
C
C Done.
C
        RETURN
C
      END
