Initial commit

1 files changed, 129 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/tests/threedt.f b/sys/gio/ncarutil/tests/threedt.f
new file mode 100644
index 00000000..0cb6532d
--- /dev/null
+++ b/sys/gio/ncarutil/tests/threedt.f
@@ -0,0 +1,129 @@
+      SUBROUTINE TTHREE	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 THE ROUTINE THREED.
+C
+C USAGE			 CALL TTHREE (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ROUTINE THREED.
+C			   =1 OTHERWISE
+C
+C I/O			 IF THERE IS A NORMAL EXIT FROM	THE ROUTINE
+C			 THREED	THE MESSAGE
+C			   THREED TEST SUCCESSFUL . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C PRECISION		 SINGLE
+C
+C LANGUAGE		 FORTRAN
+C
+C HISTORY		 ORIGINALLY WRITTEN NOVEMBER 1976
+C			 CONVERTED TO GKS AND FORTRAN 77 JULY 1984
+C
+C ALGORITHM		 ROUTINE TTHREE	CALLS SET3 TO ESTABLISH	A
+C			 MAPPING BETWEEN THE PLOTTER ADDRESSES AND
+C			 THE USER'S VOLUME, AND	TO INDICATE THE
+C			 COORDINATES OF	THE EYE	POSITION FROM
+C			 WHICH THE LINES TO BE DRAWN ARE VIEWED.
+C			 NEXT, THE VOLUME PERIMETERS AND ASSOCIATED
+C			 TICK MARKS ARE	DRAWN BY CALLS TO PERIM3.
+C			 THEN THE LINES	ARE DRAWN.  THESE ARE
+C			 CERTAIN LATITUDES AND LONGITUDES OF A
+C			 SPHERE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+C
+C
+      REAL EYE(3),X(31),Y(31),Z(31)
+C
+C SPECIFY ARGUMENT VALUES TO BE	USED BY	ROUTINE	SET3.  ON AN
+C ABSTRACT PLOTTER WITH	AN ADDRESS RANGE OF 0. TO 1. IN	EACH
+C COORDINATE DIRECTION,	THE VALUES  RXA, RXB, RYA, AND RYB
+C DEFINE THE PORTION OF	THE ADDRESS SPACE TO BE	USED IN	MAKING
+C THE PLOT.  UC, UD, VC, VD, WC, WD  DEFINE A VOLUME IN	USER
+C COORDINATES WHICH IS TO BE MAPPED ONTO THE PORTION OF	THE
+C VIEWING SURFACE AS SPECIFIED BY  RXA,	RXB, RYA, AND RYB.
+C
+      DATA RXA/0.097656/, RXB/0.90236/,	RYA/0.097656/, RYB/0.90236/
+      DATA UC/-1./, UD/1./, VC/-1./, VD/1./, WC/-1./, WD/1./
+      DATA EYE(1),EYE(2),EYE(3)/10.,6.,3./
+      DATA TX/0.4374/, TY/0.9570/
+C
+C DEFINE PI
+      DATA PI/3.1415926535898/
+C
+C
+C SELECT NORMALIZATION TRANSFORMATION 0
+C
+      CALL GSELNT (0)
+C
+C CALL SET3 TO ESTABLISH A MAPPING BETWEEN THE PLOTTER ADDRESSES
+C AND THE USER'S VOLUME, AND TO	INDICATE THE COORDINATES OF THE
+C EYE POSITION FROM WHICH THE LINES TO BE DRAWN	ARE VIEWED.
+C
+      CALL SET3(RXA,RXB,RYA,RYB,UC,UD,VC,VD,WC,WD,EYE)
+C
+C CALL PERIM3 TO DRAW PERIMETER	LINES AND TICK MARKS
+C
+      CALL PERIM3(2,5,1,10,1,-1.)
+      CALL PERIM3(4,2,1,1,2,-1.)
+      CALL PERIM3(2,10,4,5,3,-1.)
+C
+C DEFINE AND DRAW LATITUDINAL LINES ON THE SPHERE OF RADIUS ONE
+C HAVING CENTER	(0.,0.,0.)
+C
+      DO 10 J=1,18
+      THETA = FLOAT(J)*PI/9.
+      CT = COS(THETA)
+      ST = SIN(THETA)
+      DO 20 K=1,31
+      PHI = FLOAT(K-16)*PI/30.
+      Z(K) = SIN(PHI)
+      CP = COS(PHI)
+      X(K) = CT*CP
+      Y(K) = ST*CP
+   20 CONTINUE
+      CALL CURVE3(X,Y,Z,31)
+   10 CONTINUE
+C
+C DEFINE AND DRAW LONGITUDINAL LINES ON	THE SPHERE OF RADIUS ONE
+C HAVING CENTER	(0.,0.,0.)
+C
+      DO 30 K=1,5
+      PHI = FLOAT(K-3)*PI/6.
+      SP = SIN(PHI)
+      CP = COS(PHI)
+      DO 40 J=1,31
+      TUETA = FLOAT(J-1)*PI/15.
+      X(J) = COS(TUETA)*CP
+      Y(J) = SIN(TUETA)*CP
+      Z(J) = SP
+   40 CONTINUE
+      CALL CURVE3(X,Y,Z,31)
+   30 CONTINUE
+C
+C CALL WTSTR FOR THREED	PLOT TITLE
+C
+      CALL WTSTR(TX,TY,'DEMONSTRATION PLOT FOR ROUTINE THREED',2,0,0)
+      call pwrzt (1.,0.,-1.,'DEMONSTRATION PLOT FOR ROUTINE THREED', 37,
+     * 2, 2, 3, 0)
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE(6,1001)
+      RETURN
+C
+c1001 FORMAT('	   THREED TEST SUCCESSFUL', 24X,
+c    1	     'SEE PLOT TO VERIFY PERFORMANCE')
+      END