path: root/sys/gio/ncarutil/threed.f

SUBROUTINE SET3 (XA,XB,YA,YB,ULO,UHI,VLO,VHI,WLO,WHI,EYE)
C                                                                               
C +-----------------------------------------------------------------+           
C |                                                                 |           
C |                Copyright (C) 1986 by UCAR                       |           
C |        University Corporation for Atmospheric Research          |           
C |                    All Rights Reserved                          |           
C |                                                                 |           
C |                 NCARGRAPHICS  Version 1.00                      |           
C |                                                                 |           
C +-----------------------------------------------------------------+           
C                                                                               
C                                                                               
C
C
C THREE-DIMENSIONAL LINE DRAWING PACKAGE
C
C
C LATEST REVISION        JULY, 1984
C
C PURPOSE                THREED IS A PACKAGE OF SUBROUTINES THAT
C                        PROVIDES LINE DRAWING CAPABILITIES IN
C                        THREE-SPACE.
C
C USAGE                  EACH ENTRY POINT IN THIS PACKAGE IS
C                        DESCRIBED BELOW.
C
C                        SET3 (XA,XB,YA,YB,UC,UD,VC,VD,WC,WD,EYE)
C
C                          XA, XB, YA, YB  DEFINE THE PORTION OF THE
C                          PLOTTING SURFACE INTO WHICH THE USER'S
C                          PLOT WILL BE PLACED.  THESE VALUES SHOULD
C                          BE IN THE RANGE 0. TO 1.  FOR EXAMPLE, IF
C                          ONE WANTS THE PLOT TO OCCUPY THE MAXIMUM
C                          PLOTTING SURFACE, SET XA=0., YA=0., XB=1.,
C                          YB=1.; IF ONE WANTS THE PLOT TO APPEAR IN
C                          THE LOWER LEFT CORNER OF THE PLOTTING
C                          SURFACE, SET XA=0., YA=0., XB=.5, YB=.5 .
C
C                          UC, UD, VC, VD, WC, AND WD DEFINE A
C                          VOLUME IN USER-COORDINATE SPACE WHICH
C                          WILL BE TRANSFORMED ONTO THE PLOTTING
C                          SURFACE DEFINED BY XA, XB, YA, YB.
C
C                          EYE IS AN ARRAY, 3 WORDS LONG, CONTAINING THE
C                          U, V, AND W COORDINATES OF THE EYE POSITION.
C                          ALL LINES IN THE PLOT ARE DRAWN AS VIEWED
C                          FROM THE EYE.  EYE IS SPECIFIED IN USER
C                          COORDINATES AND SHOULD BE OUTSIDE THE BOX
C                          DEFINED BY UC, UD, VC, VC, WC, AND WD.
C
C                        CURVE3 (U,V,W,N)
C
C                          DRAWS A CURVE THROUGH N POINTS.  THE
C                          POINTS ARE DEFINED BY THE LINEAR ARRAYS
C                          U, V, AND W WHICH ARE DIMENSIONED N OR
C                          GREATER.
C
C                        LINE3 (UA,VA,WA,UB,VB,WB)
C
C                          DRAWS A LINE CONNECTING THE COORDINATES
C                          (UA,VA,WA)  AND  (UB,VB,WB).
C
C                        FRST3 (U,V,W)
C
C                          POSITIONS THE PEN TO (U,V,W).
C
C                        VECT3 (U,V,W)
C
C                          DRAWS A LINE BETWEEN THE CURRENT PEN
C                          POSITION AND THE POINT (U,V,W).  THE
C                          CURRENT PEN POSITION BECOMES (U,V,W).
C                          NOTE THAT A CURVE CAN BE DRAWN BY USING
C                          A FRST3 CALL FOLLOWED BY A SEQUENCE OF
C                          VECT3 CALLS.
C
C                        POINT3 (U,V,W)
C
C                          PLOTS A POINT AT (U,V,W) .
C
C                        PERIM3 (MAGR1,MINR1,MAGR2,MINR2,IWHICH,VAR)
C
C                          DRAWS A PERIMETER WITH TICK MARKS.
C
C                          IWHICH DESIGNATES THE NORMAL VECTOR TO THE
C                          PERIMETER DRAWN (1=U, 2=V, 3=W).
C
C                          VAR IS THE VALUE ON THE AXIS SPECIFIED BY
C                          INWHICH WHERE THE PERIMETER IS TO BE DRAWN.
C
C                          MAGR1  AND  MAGR2  SPECIFY THE
C                          NUMBER OF MAJOR TICK MARKS TO BE DRAWN IN
C                          THE TWO COORDINATE DIRECTIONS.
C
C                          MINR1  AND  MINR2  SPECIFY THE NUMBER
C                          OF MINOR TICKS BETWEEN EACH MAJOR TICK.
C
C                          MAGR1, MAGR2, MINR1 AND MINR2
C                          ARE SPECIFIED BY THE NUMBER
C                          OF DIVISIONS(HOLES), NOT THE NUMBER OF
C                          TICKS.  SO IF MAGR1=1, THERE WOULD BE NO
C                          MAJOR DIVISIONS.
C
C                        TICK43 (MAGU,MINU,MAGV,MINV,MAGW,MINW)
C
C                          TICK43 ALLOWS PROGRAM CONTROL OF TICK
C                          MARK LENGTH IN SUBROUTINE PERIM3.
C                          MAGU, MAGV, MAGW SPECIFY THE LENGTH,
C                          IN PLOTTER ADDRESS UNITS OF MAJOR
C                          DIVISION TICK MARKS ON THE U, V, AND W
C                          AXES.  MINU, MINV, MINW SPECIFY THE LENGTH,
C                          IN PLOTTER ADDRESS UNITS OF MINOR
C                          DIVISION TICK MARKS ON THE U, V, AND
C                          W AXES.
C
C                        FENCE3 (U,V,W,N,IOREN,BOT)
C
C                          THIS ENTRY IS USED TO DRAW A LINE IN THREE-
C                          SPACE AS WELL AS A "FENCE" BETWEEN THE
C                          LINE AND A PLANE NORMAL TO ONE OF THE
C                          COORDINATE AXES.
C
C                          THE ARGUMENTS U, V, W AND N
C                          ARE THE SAME AS FOR CURVE, DESCRIBED ABOVE.
C
C                          IOREN SPECIFIES THE DIRECTION IN WHICH THE
C                          FENCE LINES ARE TO BE DRAWN (1 INDICATES
C                          PARALLEL TO THE U-AXIS, 2 INDICATES PARALLEL
C                          TO THE V-AXIS, AND 3 INDICATES PARALLEL TO
C                          TO THE W-AXIS.)
C
C                          BOT SPECIFIES WHERE THE BOTTOM OF THE FENCE
C                          IS TO BE DRAWN.
C                          IF THE FENCE LINES ARE TO BE DRAWN PARALLEL
C                          TO THE W-AXIS, AND  BOT=2., THEN THE BOTTOM
C                          OF THE FENCE WOULD BE THE PLANE  W=2.
C
C ON OUTPUT              ALL ARGUMENTS ARE UNCHANGED.
C
C NOTES                  .  FOR DRAWING CHARACTERS IN CONJUNCTION
C                           WITH THREED, USE THE COMPANION ROUTINE
C                           PWRZT.
C
C ENTRY POINTS          FENCE3, TRN32T, FRST3, VECT3, LIN3,
C                       POINT3, CURVE3, PSYM3, PERIM3, LINE3W,
C                       DRAWT, TICK43, TICK3, THREBD
C
C COMMON BLOCKS         TEMPR, SET31, PWRZ1T, TCK31, PRM31, THRINT
C
C REQUIRED LIBRARY      PWRZ AND THE SPPS
C ROUTINES
C
C HISTORY               WRITTEN AND STANDARDIZED IN NOVEMBER 1973.
C I/O                   PLOTS LINES.
C
C PRECISION             SINGLE
C
C LANGUAGE              FORTRAN
C
C ACCURACY              + OR -.5 PLOTTER ADDRESS UNITS PER CALL.
C                       THERE IS NO CUMULATIVE ERROR.
C
C PORTABILITY           ANSI FORTRAN 77
C
C
C
C
C
      SAVE
C
      COMMON /TEMPR/  RZERO
C
      DIMENSION       EYE(3)
C
      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
     1                YMAX       ,BIGD       ,R0         ,NLX        ,
     2                NBY        ,NRX        ,NTY
      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
     2                EYEV       ,EYEW
C
C
      AVE(A,B) = (A+B)*.5
C
C ARITHMETIC STATEMENT FUNCTION FOR SCALING
C
      SU(UTEMP) = UTEMP
      SV(VTEMP) = VTEMP
      SW(WTEMP) = WTEMP
C
C +NOAO - Blockdata threbd rewritten as run time initialization.
C
C     EXTERNAL        THREBD
      call threbd
C -NOAO
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','SET3','VERSION  1')
C
C SET UP FRAME SIZE
C
      NLX = XA*1023.+1.
      NRX = XB*1023.+1.
      NBY = YA*1023.+1.
      NTY = YB*1023.+1.
C
C CONSTANTS FOR PWRZT
C
      UUMIN = ULO
      UUMAX = UHI
      VVMIN = VLO
      VVMAX = VHI
      WWMIN = WLO
      WWMAX = WHI
      EYEU = EYE(1)
      EYEV = EYE(2)
      EYEW = EYE(3)
C
C FIND CORNERS IN 2-SPACE FOR 3-SPACE BOX CONTAINING OBJECT
C
      ISCALE = 0
      ATU = AVE(SU(UUMIN),SU(UUMAX))
      ATV = AVE(SV(VVMIN),SV(VVMAX))
      ATW = AVE(SW(WWMIN),SW(WWMAX))
      BIGD = 0.
      IF (RZERO .LE. 0.) GO TO  10
C
C RELATIVE SIZE FEATURE IN USE.  THIS SECTION OF CODE IS NEVER
C EXECUTED UNLESS RZERO IS SET POSITIVE IN THE CALLING PROGRAM
C VIA COMMON BLOCK TEMPR.  RZERO  IS THE DISTANCE BETWEEN THE
C OBSERVER AND THE POINT LOOKED AT (CENTER OF THE BOX BY DEFAULT)
C WHEN THE INPUT BOX IS TO FILL THE SCREEN WHEN VIEWED FROM THE
C DIRECTION WHICH MAKES THE BOX BIGGEST.  RZERO  IS THUS TO
C BE USED TO DETERMINE THE SHAPE OF THE OBJECT.   THIS SECTION
C OF CODE IS TO BE USED WHEN IT IS DESIRED TO KEEP THE VIEWED
C OBJECT IN RELATIVE PERSPECTIVE ACROSS FRAMES--E.G. IN MAKING
C MOVIES.
C
      ALPHA = -(VVMIN-ATV)/(UUMIN-ATU)
      VVEYE = -RZERO/SQRT(1.+ALPHA*ALPHA)
      UUEYE = VVEYE*ALPHA
      VVEYE = VVEYE+ATV
      UUEYE = UUEYE+ATU
      WWEYE = ATW
      CALL TRN32T (ATU,ATV,ATW,UUEYE,VVEYE,WWEYE,1)
      CALL TRN32T (UUMIN,VVMIN,ATW,XMIN,DUMM,DUMM,2)
      CALL TRN32T (UUMAX,VVMIN,WWMIN,DUMM,YMIN,DUMM,2)
      CALL TRN32T (UUMAX,VVMAX,ATW,XMAX,DUMM,DUMM,2)
      CALL TRN32T (UUMAX,VVMIN,WWMAX,DUMM,YMAX,DUMM,2)
      BIGD = SQRT((UUMAX-UUMIN)**2+(VVMAX-VVMIN)**2+(WWMAX-WWMIN)**2)*.5
      R0 = RZERO
      GO TO  20
   10 CALL TRN32T (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
      CALL TRN32T (SU(UUMIN),SV(VVMIN),SW(WWMIN),X1,Y1,DUM,2)
      CALL TRN32T (SU(UUMIN),SV(VVMIN),SW(WWMAX),X2,Y2,DUM,2)
      CALL TRN32T (SU(UUMIN),SV(VVMAX),SW(WWMIN),X3,Y3,DUM,2)
      CALL TRN32T (SU(UUMIN),SV(VVMAX),SW(WWMAX),X4,Y4,DUM,2)
      CALL TRN32T (SU(UUMAX),SV(VVMIN),SW(WWMIN),X5,Y5,DUM,2)
      CALL TRN32T (SU(UUMAX),SV(VVMIN),SW(WWMAX),X6,Y6,DUM,2)
      CALL TRN32T (SU(UUMAX),SV(VVMAX),SW(WWMIN),X7,Y7,DUM,2)
      CALL TRN32T (SU(UUMAX),SV(VVMAX),SW(WWMAX),X8,Y8,DUM,2)
      XMIN = AMIN1(X1,X2,X3,X4,X5,X6,X7,X8)
      XMAX = AMAX1(X1,X2,X3,X4,X5,X6,X7,X8)
      YMIN = AMIN1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
      YMAX = AMAX1(Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8)
C
C ADD RIGHT AMOUNT TO KEEP PICTURE SQUARE
C
   20 WIDTH = XMAX-XMIN
      HIGHT = YMAX-YMIN
      DIF = .5*(WIDTH-HIGHT)
      IF (DIF)  30, 50, 40
   30 XMIN = XMIN+DIF
      XMAX = XMAX-DIF
      GO TO  50
   40 YMIN = YMIN-DIF
      YMAX = YMAX+DIF
   50 ISCALE = 1
      CALL TRN32T (ATU,ATV,ATW,EYE(1),EYE(2),EYE(3),1)
      RETURN
      END
      SUBROUTINE TRN32T (U,V,W,XT,YT,ZT,IENT)
C
C THIS ROUTINE IMPLEMENTS THE 3-SPACE TO 2-SPACE TRANSFOR-
C MATION BY KUBER, SZABO AND GIULIERI, THE PERSPECTIVE
C REPRESENTATION OF FUNCTIONS OF TWO VARIABLES. J. ACM 15,
C 2, 193-204,1968.
C TRN32T ARGUMENTS
C U,V,W    ARE THE 3-SPACE COORDINATES OF THE INTERSECTION
C          OF THE LINE OF SIGHT AND THE IMAGE PLANE.  THIS
C          POINT CAN BE THOUGHT OF AS THE POINT LOOKED AT.
C XT,YT,ZT ARE THE 3-SPACE COORDINATES OF THE EYE POSITION.
C
C TRN32 ARGUMENTS
C U,V,W    ARE THE 3-SPACE COORDINATES OF A POINT TO BE
C          TRANSFORMED.
C XT,YT    THE RESULTS OF THE 3-SPACE TO 2-SPACE TRANSFOR-
C          MATION.  WHEN ISCALE=0, XT AND YT ANR IN THE SAME
C          UNITS AS U,V, AND W.  WHEN ISCALE'0, XT AND YT
C          ARE IN PLOTTER COORDINATES.
C ZT       NOT USED.
C
C
      SAVE
C
      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
     2                EYEV       ,EYEW
      COMMON /SET31/  ISCALE     ,XMIN       ,XMAX       ,YMIN       ,
     1                YMAX       ,BIGD       ,R0         ,NLX        ,
     2                NBY        ,NRX        ,NTY
C
C DECIDE IF SET OR TRANSLATE CALL
C
      IF (IENT .NE. 1) GO TO  50
C
C STORE THE PARAMETERS OF THE SET CALL
C FOR USE WITH THE TRANSLATION CALL
C
      AU = U
      AV = V
      AW = W
      EU = XT
      EV = YT
      EW = ZT
C
C
C
C
C
      DU = AU-EU
      DV = AV-EV
      DW = AW-EW
      D = SQRT(DU*DU+DV*DV+DW*DW)
      COSAL = DU/D
      COSBE = DV/D
      COSGA = DW/D
      AL = ACOS(COSAL)
      BE = ACOS(COSBE)
      GA = ACOS(COSGA)
      SINGA = SIN(GA)
C
C THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF
C THE 2-SPACE.  THE 3-SPACE W AXIS IS TRANSFORMED INTO THE
C 2-SPACE Y AXIS.  IF THE LINE OF SIGHT IS CLOSE TO PARALLEL
C TO THE 3-SPACE W AXIS, THE 3-SPACE V AXIS IS CHOSEN (IN-
C STEAD OF THE 3-SPACE W AXIS) TO BE TRANSFORMED INTO THE
C 2-SPACE Y AXIS.
C
      ASSIGN  90 TO JDONE
      IF (ISCALE)  10, 30, 10
   10 X0 = XMIN
      Y0 = YMIN
      X1 = NLX
      Y1 = NBY
      X2 = NRX-NLX
      Y2 = NTY-NBY
      X3 = X2/(XMAX-XMIN)
      Y3 = Y2/(YMAX-YMIN)
      X4 = NRX
      Y4 = NTY
      FACT = 1.
      IF (BIGD .LE. 0.) GO TO  20
      X0 = -BIGD
      Y0 = -BIGD
      X3 = X2/(2.*BIGD)
      Y3 = Y2/(2.*BIGD)
      FACT = R0/D
   20 DELCRT = X2
      ASSIGN  80 TO JDONE
   30 IF (SINGA .LT. 0.0001) GO TO  40
      R = 1./SINGA
      ASSIGN  70 TO JUMP
      RETURN
   40 SINBE = SIN(BE)
      R = 1./SINBE
      ASSIGN  60 TO JUMP
      RETURN
C
C********************  ENTRY TRN32  ************************
C     ENTRY TRN32 (U,V,W,XT,YT,ZT)
C
   50 UU = U
      VV = V
      WW = W
      Q = D/((UU-EU)*COSAL+(VV-EV)*COSBE+(WW-EW)*COSGA)
      GO TO JUMP,( 60, 70)
   60 UU = ((EW+Q*(WW-EW)-AW)*COSAL-(EU+Q*(UU-EU)-AU)*COSGA)*R
      VV = (EV+Q*(VV-EV)-AV)*R
      GO TO JDONE,( 80, 90)
   70 UU = ((EU+Q*(UU-EU)-AU)*COSBE-(EV+Q*(VV-EV)-AV)*COSAL)*R
      VV = (EW+Q*(WW-EW)-AW)*R
      GO TO JDONE,( 80, 90)
   80 XT = X1+X3*(FACT*UU-X0)
      YT = Y1+Y3*(FACT*VV-Y0)
      RETURN
   90 XT = UU
      YT = VV
      RETURN
      END
      SUBROUTINE FRST3 (U,V,W)
      SAVE
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','FRST3','VERSION  1')
      XDUM = 5.
      CALL TRN32T (U,V,W,X,Y,XDUM,2)
      CALL PLOTIT  (32*IFIX(X),32*IFIX(Y),0)
      RETURN
      END
      SUBROUTINE VECT3 (U,V,W)
      SAVE
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','VECT3','VERSION  1')
      CALL TRN32T (U,V,W,X,Y,ZDUM,2)
      IIX = 32*IFIX(X)
      IIY = 32*IFIX(Y)
      CALL PLOTIT  (IIX,IIY,1)
C
C     FLUSH PLOTIT BUFFER
C
      CALL PLOTIT  (IIX,IIY,0)
      RETURN
      END
      SUBROUTINE LINE3 (UA,VA,WA,UB,VB,WB)
      SAVE
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','LINE3','VERSION  1')
      CALL TRN32T (UA,VA,WA,XA,YA,XDUM,2)
      CALL TRN32T (UB,VB,WB,XB,YB,XDUM,2)
      IIX = 32*IFIX(XB)
      IIY = 32*IFIX(YB)
      CALL PLOTIT (32*IFIX(XA),32*IFIX(YA),0)
      CALL PLOTIT (IIX,IIY,1)
C
C     FLUSH PLOTIT BUFFER
C
      CALL PLOTIT (IIX,IIY,0)
      RETURN
      END
      SUBROUTINE POINT3 (U,V,W)
      SAVE
      DIMENSION VWPRT(4),WNDW(4)
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','POINT3','VERSION  1')
C
C INQUIRE CURRENT NORMALIZATION TRANS NUMBER
C
      CALL GQCNTN (IERR,NTORIG)
C
C SAVE NORMALIZATION TRANS 1 AND CURRENT LOG SCALING
C
      CALL GQNT (1,IERR,WNDW,VWPRT)
      CALL GETUSV ('LS',IOLLS)
C
C DEFINE NOMALIZATION TRANS TO BE USED WITH POLYMARKER
C
      CALL SET(0.0, 1.0, 0.0, 1.0, 1.0, 1024.0, 1.0, 1024.0, 1)
C
C SET MARKER TYPE TO 1
C
      CALL GSMK (1)
      CALL TRN32T (U,V,W,X,Y,ZDUM,2)
      PX = X
      PY = Y
      CALL GPM (1,PX,PY)
C
C RESTORE ORIGINAL TRANS 1 AND SELECT TRANS NUMBER NTORIG
C RESTORE LOG SCALING
C
      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
      CALL GSELNT (NTORIG)
      RETURN
      END
      SUBROUTINE CURVE3 (U,V,W,N)
      SAVE
      DIMENSION       U(N)       ,V(N)       ,W(N)
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','CURVE3','VERSION  1')
      CALL TRN32T (U(1),V(1),W(1),X,Y,ZDUM,2)
      CALL PLOTIT (32*IFIX(X),32*IFIX(Y),0)
      NN = N
      IF (NN .LT. 2) RETURN
      DO  10 I=2,NN
         UU = U(I)
         VV = V(I)
         WW = W(I)
         CALL TRN32T (UU,VV,WW,X,Y,ZDUM,2)
         CALL PLOTIT (32*IFIX(X),32*IFIX(Y),1)
   10 CONTINUE
C
C     FLUSH PLOTIT BUFFER
C
      CALL PLOTIT(0,0,0)
      RETURN
      END
      SUBROUTINE PSYM3 (U,V,W,ICHAR,SIZE,IDIR,ITOP,IUP)
      SAVE
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','PSYM3','VERSION  1')
      IF (IUP .EQ. 2) CALL VECT3 (U,V,W)
      CALL PWRZ (U,V,W,ICHAR,1,SIZE,IDIR,ITOP,0)
      RETURN
      END
      SUBROUTINE PERIM3 (MAGR1,MINI1,MAGR2,MINI2,IWHICH,VAR)
      SAVE
      COMMON /PWRZ1T/ UUMIN      ,UUMAX      ,VVMIN      ,VVMAX      ,
     1                WWMIN      ,WWMAX      ,DELCRT     ,EYEU       ,
     2                EYEV       ,EYEW
      COMMON /PRM31/  Q          ,L
      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV      ,TMINV      ,
     1                TMAGW      ,TMINW
C
C THRINT COMMON BLOCK IS USED FOR SETTING COLOR INTENSITY
C
      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
      DIMENSION       LASF(13)
C
      TICK(T) = AMAX1(UUMAX-UUMIN,VVMAX-VVMIN,WWMAX-WWMIN)*T/1024.
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','PERIM3','VERSION  1')
C
C INQUIRE LINE COLOR INDEX AND SET ASF TO INDIVIDUAL
C
      CALL GQPLCI (IERR, IPLCI)
      CALL GQASF (IERR, LASF)
      LSV3  = LASF(3)
      LASF(3) = 1
      CALL GSASF (LASF)
C
      MGR1 = MAGR1
      MN1 = MINI1-1
      MGR2 = MAGR2
      MN2 = MINI2-1
      MN1P1 = MAX0(MN1+1,1)
      MN2P1 = MAX0(MN2+1,1)
      L = MIN0(3,MAX0(1,IWHICH))
      Q = VAR
C
C PICK BOUNDS
C
      GO TO ( 10, 30, 40),L
   10 XMIN = VVMIN
      XMAX = VVMAX
      DELXL = TICK(TMAGU)
      DELXS = TICK(TMINU)
   20 YMIN = WWMIN
      YMAX = WWMAX
      DELYL = TICK(TMAGW)
      DELYS = TICK(TMINW)
      GO TO  50
   30 XMIN = UUMIN
      XMAX = UUMAX
      DELXL = TICK(TMAGU)
      DELXS = TICK(TMINU)
      GO TO  20
   40 XMIN = UUMIN
      XMAX = UUMAX
      DELXL = TICK(TMAGU)
      DELXS = TICK(TMINU)
      YMIN = VVMIN
      YMAX = VVMAX
      DELYL = TICK(TMAGV)
      DELYS = TICK(TMINV)
C
C PERIM
C
   50 CALL LINE3W (XMIN,YMIN,XMAX,YMIN)
      CALL LINE3W (XMAX,YMIN,XMAX,YMAX)
      CALL LINE3W (XMAX,YMAX,XMIN,YMAX)
      CALL LINE3W (XMIN,YMAX,XMIN,YMIN)
      IF (MGR1 .LT. 1) GO TO  90
      DX = (XMAX-XMIN)/AMAX0(MGR1*(MN1P1),1)
      DO  80 I=1,MGR1
C
C MINORS FIRST
C
         IF (MN1 .LE. 0) GO TO  70
C
C SET LINE INTENSITY TO LOW
C
         CALL GSPLCI (ITHRMN)
         DO  60 J=1,MN1
            X = XMIN+FLOAT(MN1P1*(I-1)+J)*DX
            CALL LINE3W (X,YMIN,X,YMIN+DELYS)
            CALL LINE3W (X,YMAX,X,YMAX-DELYS)
   60    CONTINUE
   70    IF (I .GE. MGR1) GO TO  90
C
C SET LINE INTENSITY TO HIGH
C
         CALL GSPLCI (ITHRMJ)
         X = XMIN+FLOAT(MN1P1*I)*DX
C
C MAJORS
C
         CALL LINE3W (X,YMIN,X,YMIN+DELYL)
         CALL LINE3W (X,YMAX,X,YMAX-DELYL)
   80 CONTINUE
   90 IF (MGR2 .LT. 1) GO TO 130
      DY = (YMAX-YMIN)/AMAX0(MGR2*(MN2P1),1)
      DO 120 J=1,MGR2
         IF (MN2 .LE. 0) GO TO 110
         DO 100 I=1,MN2
            Y = YMIN+FLOAT(MN2P1*(J-1)+I)*DY
            CALL LINE3W (XMIN,Y,XMIN+DELXS,Y)
C
C SET LINE INTENSITY TO LOW
C
            CALL GSPLCI (ITHRMN)
            CALL LINE3W (XMAX,Y,XMAX-DELXS,Y)
  100    CONTINUE
  110    IF (J .GE. MGR2) GO TO 130
C
C SET LINE INTENSITY TO HIGH
C
         CALL GSPLCI (ITHRMJ)
         Y = YMIN+FLOAT(MN2P1*J)*DY
         CALL LINE3W (XMIN,Y,XMIN+DELXL,Y)
         CALL LINE3W (XMAX,Y,XMAX-DELXL,Y)
  120 CONTINUE
C
C RESTORE ASF AND LINE INTENSITY TO ORIGINAL
C
  130 LASF(3) = LSV3
      CALL GSASF (LASF)
      CALL GSPLCI (IPLCI)
      RETURN
      END
      SUBROUTINE LINE3W (XA,YA,XB,YB)
      SAVE
      COMMON /PRM31/  Q          ,L
      GO TO ( 10, 30, 40),L
   10 UA = Q
      UB = Q
      VA = XA
      VB = XB
   20 WA = YA
      WB = YB
      GO TO  50
   30 UA = XA
      UB = XB
      VA = Q
      VB = Q
      GO TO  20
   40 UA = XA
      UB = XB
      VA = YA
      VB = YB
      WA = Q
      WB = Q
   50 CALL LINE3 (UA,VA,WA,UB,VB,WB)
      RETURN
      END
      SUBROUTINE DRAWT (IXA,IYA,IXB,IYB)
      SAVE
      CALL PLOTIT(32*IXA,32*IYA,0)
      IIX = 32*IXB
      IIY = 32*IYB
      CALL PLOTIT(IIX,IIY,1)
C
C     FLUSH PLOTIT BUFFER
C
      CALL PLOTIT(IIX,IIY,0)
      RETURN
      END
      SUBROUTINE TICK43 (MAGU,MINU,MAGV,MINV,MAGW,MINW)
      SAVE
      COMMON /TCK31/  TMAGU      ,TMINU      ,TMAGV      ,TMINV      ,
     1                TMAGW      ,TMINW
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','TICK43','VERSION  1')
      TMAGU = MAGU
      TMINU = MINU
      TMAGV = MAGV
      TMINV = MINV
      TMAGW = MAGW
      TMINW = MINW
      RETURN
      END
      SUBROUTINE TICK3 (MAG,MIN)
      SAVE
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','TICK3','VERSION  1')
      CALL TICK43 (MAG,MIN,MAG,MIN,MAG,MIN)
      RETURN
      END
      SUBROUTINE FENCE3 (U,V,W,N,IOR,BOT)
      SAVE
      REAL            U(N)       ,V(N)       ,W(N)
      DIMENSION       LASF(13)
C
C COMMON BLOCK THRINT IS USED FOR SETTING COLOR INTENSITY
C
      COMMON /THRINT/ ITHRMJ     ,ITHRMN     ,ITHRTX
C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','THREED','FENCE3','VERSION  1')
C
C INQUIRE LINE COLOR INDEX AND SET ASF TO INDIVIDUAL
C
      CALL GQPLCI (IERR, IPLCI)
      CALL GQASF (IERR, LASF)
      LSV3  = LASF(3)
      LASF(3) = 1
      CALL GSASF (LASF)
C
      M = N
      BASE = BOT
      L = MAX0(1,MIN0(3,IOR))
C
C SET LINE INTENSITY TO LOW
C
      CALL GSPLCI (ITHRMN)
      GO TO ( 10, 40, 70),L
   10 CALL FRST3 (BASE,V(1),W(1))
      DO  20 I=2,M
         VV = V(I)
         WW = W(I)
         CALL VECT3 (BASE,VV,WW)
   20 CONTINUE
      DO  30 I=1,M
         UU = U(I)
         VV = V(I)
         WW = W(I)
         CALL LINE3 (UU,VV,WW,BASE,VV,WW)
   30 CONTINUE
      GO TO 100
   40 CALL FRST3 (U(1),BASE,W(1))
      DO  50 I=2,M
         UU = U(I)
         WW = W(I)
         CALL VECT3 (UU,BASE,WW)
   50 CONTINUE
      DO  60 I=1,M
         UU = U(I)
         VV = V(I)
         WW = W(I)
         CALL LINE3 (UU,VV,WW,UU,BASE,WW)
   60 CONTINUE
      GO TO 100
   70 CALL FRST3 (U(1),V(1),BASE)
      DO  80 I=2,M
         UU = U(I)
         VV = V(I)
         CALL VECT3 (UU,VV,BASE)
   80 CONTINUE
      DO  90 I=1,M
         UU = U(I)
         VV = V(I)
         WW = W(I)
         CALL LINE3 (UU,VV,WW,UU,VV,BASE)
   90 CONTINUE
C
C SET LINE INTENSITY TO HIGH
C
  100 CALL GSPLCI (ITHRMJ)
      CALL CURVE3 (U,V,W,M)
C
C RESTORE ASF AND LINE INTENSITY TO ORIGINAL
C
      LASF(3) = LSV3
      CALL GSASF (LASF)
      CALL GSPLCI (IPLCI)
C
      RETURN
C
C REVISION HISTORY---
C
C JANUARY 1978     DELETED REFERENCES TO THE  *COSY  CARDS AND
C                  ADDED REVISION HISTORY
C FEBURARY 1979    MODIFIED CODE TO CONFORM TO FORTRAN 66 STANDARD
C JUNE 1979        UPDATED FILE TO INCLUDE BLOCK DATA PWRZBD AND
C                  CORRECT A COMMENTED OUT STATEMENT IN CURVE3.
C MARCH 1980       REMOVED THE PWRZ AND PWRITZ ENTRIES.  THESE
C                  CAPABILITIES WERE REPLACED WITH THE NEW ULIB FILE
C                  PWRZT.
C JULY 1984        CONVERTED TO FORTRAN 77 AND GKS
C-----------------------------------------------------------------------
C
      END
      SUBROUTINE PWRZ (X,Y,Z,ID,N,ISIZE,LIN3,ITOP,ICNT)
C     WRITE (6,1001)
C     WRITE (6,1002)
C     STOP
C
C1001 FORMAT (1H1//////////)
C1002 FORMAT (' *****************************************'/
C    1        ' *                                       *'/
C    2        ' *                                       *'/
C    3        ' *   THE ENTRY POINT PWRZ IS NO LONGER   *'/
C    4        ' *   SUPPORTED.  THE CAPABILITIES OF     *'/
C    5        ' *   THIS OLD ENTRY ARE NOW AVAILABLE    *'/
C    6        ' *   IN THE NEW PORTABLE VERSIONS        *'/
C    7        ' *                                       *'/
C    8        ' *        PWRZS  FOR USE WITH SRFACE     *'/
C    9        ' *        PWRZI  FOR USE WITH ISOSRF     *'/
C    +        ' *        PWRZT  FOR USE WITH THREED     *'/
C    1        ' *                                       *'/
C    2        ' *   FOR USAGE OF THESE ROUTINES, SEE    *'/
C    3        ' *   THE DOCUMENTATION FOR THE DESIRED   *'/
C    4        ' *   ROUTINE.                            *'/
C    5        ' *                                       *'/
C    6        ' *                                       *'/
C    7        ' *****************************************')
C
      END