1 files changed, 137 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/tests/isosrft.f b/sys/gio/ncarutil/tests/isosrft.f
new file mode 100644
index 00000000..1e99e02e
--- /dev/null
+++ b/sys/gio/ncarutil/tests/isosrft.f
@@ -0,0 +1,137 @@
+      SUBROUTINE TISOSR	(nplot, IERROR)
+C
+C LATEST REVISION	 DECEMBER 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 ISOSRF	AND TO TEST ISOSRF ON A	SINGLE PROBLEM
+C
+C USAGE			 CALL TISOSR (IERROR)
+C
+C ARGUMENTS
+C
+C ON OUTPUT		 IERROR
+C			   AN INTEGER VARIABLE
+C			   = 0,	IF THE TEST WAS	SUCCESSFUL,
+C			   = 1,	OTHERWISE
+C
+C I/O			 IF THE	TEST IS	SUCCESSFUL, THE	MESSAGE
+C
+C			   ISOSRF TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS WRITTEN ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE	SAMPLE
+C			 PLOTS ARE PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 ISOSRF	FROM ULIB LIBRARY
+C FILES
+C
+C LANGUAGE		 STANDARD FORTRAN77
+C
+C HISTORY		 WRITTEN  BY MEMBERS OF	THE
+C			 SCIENTIFIC COMPUTING DIVISION OF NCAR,
+C			 BOULDER COLORADO
+C
+C ALGORITHM		 A FUNCTION OF THREE VARIABLES IS DEFINED, AND
+C			 VALUES	OF THE FUNCTION	ON A THREE DIMENSIONAL
+C			 RECTANGULAR GRID ARE STORED IN	AN ARRAY.  THIS
+C			 SUBROUTINE CALLS EZISOS AND ISOSRF TO DRAW ISO-
+C			 VALUED	SURFACE	PLOTS OF THE FUNCTION.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+      SAVE
+      DIMENSION	      T(21,31,19),SLAB(33,33),EYE(3)
+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
+      REAL IX,IY
+      DATA IX/.44/, IY/.95/
+C
+      DATA NU,NV,NW/21,31,19/
+      DATA RBIG1,RBIG2,RSML1,RSML2/6.,6.,2.,2./
+      DATA TISO/0./
+      DATA MUVWP2/33/
+      DATA IFLAG/-7/
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 1
+C
+C FILL THREE DIMENSIONAL ARRAY TO BE PLOTTED
+C
+      JCENT1 = FLOAT(NV)*.5-RBIG1*.5
+      JCENT2 = FLOAT(NV)*.5+RBIG2*.5
+      DO  30 I=1,NU
+	 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
+	       T(I,J,K)	= AMIN1(FIMID*FIMID+FJP1*FJP1+FKP1*FKP1-
+     1			  RSML1*RSML1,
+     2			    FKMID*FKMID+FIP2*FIP2+FJP2*FJP2-RSML2*RSML2)
+   10	    CONTINUE
+   20	 CONTINUE
+   30 CONTINUE
+C
+C DEFINE EYE POSITION
+C
+      EYE(1) = 100.
+      EYE(2) = 150.
+      EYE(3) = 125.
+C
+C LABEL	THE PLOT TO BE DRAWN BY	EZISOS
+C
+      if (nplot .eq. 1) then
+      CALL GSELNT(0)
+      CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY EZISOS OF ISOSRF',
+     1 2,0,0)
+C
+C TEST EZISOS
+C
+      CALL EZISOS (T,NU,NV,NW,EYE,SLAB,TISO)
+      endif
+C
+C LABEL	THE PLOT TO BE DRAWN BY	ISOSRF
+C
+      if (nplot .eq. 2) then
+      CALL GSELNT(0)
+      CALL WTSTR(IX,IY,'DEMONSTRATION PLOT FOR ENTRY ISOSRF OF ISOSRF',
+     1 2,0,0)
+C
+C TEST ISOSRF WITH SUBARRAY OF T
+C
+      MU=NU/2
+      MV=NV/2
+      MW=NW/2
+      MUVWP2=MAX0(MU,MV,MW)+2
+      CALL ISOSRF(T(MU,MV,MW),NU,MU,NV,MV,MW,EYE,MUVWP2,SLAB,TISO,IFLAG)
+      endif
+c     CALL FRAME
+C
+      IERROR = 0
+c     WRITE (6,1001)
+      RETURN
+C
+c1001 FORMAT ('	    ISOSRF TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END