Initial commit

1 files changed, 165 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/tests/isosrfhrt.f b/sys/gio/ncarutil/tests/isosrfhrt.f
new file mode 100644
index 00000000..1d8fb249
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrfhrt.f
@@ -0,0 +1,165 @@
+      SUBROUTINE TISOHR	(IERROR)
+C
+C LATEST REVISION	 JULY 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 THE  ISOSRFHR	PACKAGE
+C
+C USAGE			 CALL TISOHR (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   =0 IF THERE IS A NORMAL EXIT	FROM THE
+C			      ISOSRFHR	ROUTINES
+C			   =1 OTHERWISE
+C
+C I/O			 THIS ROUTINE REQUIRES UNIT IUNIT FOR SCRATCH
+C			 PURPOSES.  USERS SHOULD PUT THE UNITS LABELLED
+C			 COMMON	(SEE BELOW) IN THE CALLING PROGRAM,
+C			 AND ALSO SET THE VALUE	OF THE COMMON VARIABLE
+C			 IUNIT IN THE CALLING PROGRAM.
+C
+C			 IF THERE IS A NORMAL EXIT FROM	THE
+C			 ISOSRFHR  ROUTINES THE	MESSAGE
+C			   ISOSRFHR TEST SUCCESSFUL . .	. SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C			 IS PRINTED.
+C
+C			 ALSO, A SAMPLE	PLOT IS
+C			 PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  ONE MUST EXAMINE THIS	PLOT
+C			 TO DETERMINE IF THE ROUTINES HAVE
+C			 EXECUTED CORRECTLY.
+C
+C COMMON BLOCKS		 UNITS
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 ISOSRFHR
+C FILES
+C
+C LANGUAGE		 FORTRAN
+C
+C ALGORITHM		 THIS SUBROUTINE USES THE ROUTINES IN
+C			 THE PACKAGE  ISOSRFHR	TO DRAW	A PERSPECTIVE
+C			 DRAWING OF TWO	INTERLOCKING DOUGHNUTS
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+      DIMENSION	      EYE(3)	 ,S(4)	     ,IS2(4,200) ,
+     1		      ST1(81,51,2)	     ,IOBJS(81,51)
+      COMMON /UNITS/  IUNIT
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE INTEGER COORDINATES RANGE	FROM 1 TO 1024,	THE VALUES IX AND IY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA IX/448/, IY/990/
+C
+C
+C     DEFINE THE EYE POSITION
+C
+      DATA	      EYE(1), EYE(2), EYE(3) / 200., 250., 250.	/
+C
+C     DEFINE THE OVERALL DIMENSION OF THE BOX CONTAINING THE OBJECTS
+C
+      DATA	      NU, NV, NW /  51,	81, 51 /
+C
+C     SPECIFY THE DIMENSIONS OF	THE MODEL OF THE IMAGE PLANE
+C
+      DATA	      LX, NX, NY / 4, 180, 180 /
+C
+C     SPECIFY  CRT  COORDINATES	OF THE AREA WHERE THE PICTURE
+C     IS TO BE DRAWN
+C
+      DATA	      S(1),S(2),S(3),S(4)/ 10.,1010.,10.,1010./
+      DATA	      MV / 81 /
+C
+C     SPECIFY THE LARGE	AND SMALL RADII	FOR THE	INDIVIDUAL DOUGHNUTS
+C
+      DATA	      RBIG1,RBIG2,RSML1,RSML2/ 20., 20., 6., 6.	/
+C
+      SAVE
+C
+C     CALL THE INITIALIZATION ROUTINE
+C
+      CALL INIT3D (EYE,NU,NV,NW,ST1,LX,NY,IS2,IUNIT,S)
+C
+C     INITIALIZE THE ERRROR FLAG
+C
+      IERROR = 1
+C
+C     CREATE AND PLOT DATA FOR TWO INTERLOCKING	DOUGHNUTS
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  70 IBKWDS=1,NU
+	 I = NU+1-IBKWDS
+C
+C     CREATE THE I-TH CROSS SECTION IN THE U DIRECTION OF THE
+C     THREE-DIMENSIONAL	ARRAY AND STORE	IN  IOBJS  AS ZEROS AND	ONES
+C
+	 FIMID = I-NU/2
+	 DO  20	J=1,NV
+	    FJMID1 = J-JCENT1
+	    FJMID2 = J-JCENT2
+	    DO	10 K=1,NW
+	       FKMID = K-NW/2
+	       F1 = SQRT(RBIG1*RBIG1/(FJMID1*FJMID1+FKMID*FKMID+.1))
+	       F2 = SQRT(RBIG2*RBIG2/(FIMID*FIMID+FJMID2*FJMID2+.1))
+	       FIP1 = (1.-F1)*FIMID
+	       FIP2 = (1.-F2)*FIMID
+	       FJP1 = (1.-F1)*FJMID1
+	       FJP2 = (1.-F2)*FJMID2
+	       FKP1 = (1.-F1)*FKMID
+	       FKP2 = (1.-F2)*FKMID
+	       TEMP = AMIN1(FIMID**2+FJP1**2+FKP1**2-RSML1**2,
+     1				      FKMID**2+FIP2**2+FJP2**2-RSML2**2)
+	       IF (TEMP	.LE. 0.) IOBJS(J,K) = 1
+	       IF (TEMP	.GT. 0.) IOBJS(J,K) = 0
+   10	    CONTINUE
+   20	 CONTINUE
+C
+C     SET PROPER WORDS TO  1  FOR DRAWING AXES
+C
+	 IF (I .NE. 1) GO TO  50
+	 DO  30	K=1,NW
+	    IOBJS(1,K) = 1
+   30	 CONTINUE
+	 DO  40	J=1,NV
+	    IOBJS(J,1) = 1
+   40	 CONTINUE
+	 GO TO	60
+   50	 CONTINUE
+	 IOBJS(1,1) = 1
+   60	 CONTINUE
+C
+C     CALL THE DRAW AND	REMEMBER ROUTINE FOR THIS SLAB
+C
+	 CALL DANDR (NV,NW,ST1,LX,NX,NY,IS2,IUNIT,S,IOBJS,MV)
+   70 CONTINUE
+C
+C    TITLE THE PLOT
+C
+      CALL GQCNTN(IER,ICN)
+      CALL GSELNT(0)
+      XC = PAU2FX(IX)
+      YC = PAU2FY(IY)
+      CALL WTSTR(XC,YC,'DEMONSTRATION PLOT FOR ISOSRFHR',2,0,0)
+      CALL GSELNT(ICN)
+C
+C     ADVANCE THE PLOTTING DEVICE
+C
+c     CALL NEWFM
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	  ISOSRFHR TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END