Initial commit

1 files changed, 826 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/threed.f b/sys/gio/ncarutil/threed.f
new file mode 100644
index 00000000..3b5061f4
--- /dev/null
+++ b/sys/gio/ncarutil/threed.f
@@ -0,0 +1,826 @@
+      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