Repatch (from linux) of OSX IRAF

1 files changed, 132 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/tests/pwrzit.f b/sys/gio/ncarutil/tests/pwrzit.f
new file mode 100644
index 00000000..7c96e926
--- /dev/null
+++ b/sys/gio/ncarutil/tests/pwrzit.f
@@ -0,0 +1,132 @@
+      SUBROUTINE TPWRZI	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 PWRZI IN CONJUNCTION WITH ISOSRF
+C
+C USAGE			 CALL TPWRZI (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			   PWRZI TEST SUCCESSFUL  . . .	SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, ONE FRAME	CONTAINING THE SAMPLE
+C			 PLOT IS PRODUCED ON THE MACHINE GRAPHICS
+C			 DEVICE.  IN ORDER TO DETERMINE	IF THE TEST
+C			 WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THIS PLOT.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 PWRZI,	ISOSRF
+C FILES
+C
+C
+C LANGUAGE		 FORTRAN
+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 THEN CALLS ISOSRF TO DRAW AN
+C			 ISO-VALUED SURFACE PLOT OF THE	FUNCTION,
+C			 THEN PWRZI IS CALLED THREE TIMES TO
+C			 LABEL THE FRONT, SIDE,	AND BACK OF THE
+C			 PICTURE.
+C
+C PORTABILITY		 ANSI FORTRAN 77
+C
+C
+      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 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE TITLE STRING.
+C
+      DATA TX/0.4375/, TY/0.9667/
+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 SELECT NORMALIZATION TRANS NUMBER 0
+C
+      CALL GSELNT (0)
+C
+C
+C LABEL	THE PLOT
+C
+      CALL WTSTR (TX,TY,'DEMONSTRATION PLOT FOR	PWRZI',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,
+     1		   IFLAG)
+      ISIZE = 35
+      CALL PWRZI (5.,16.,.5,'FRONT',5,ISIZE,-1,3,0)
+      CALL PWRZI (11.,7.5,.5,'SIDE',4,ISIZE,2,-1,0)
+      CALL PWRZI (5.,1.,5.,' BACK BACK BACK BACK BACK',25,ISIZE,-1,3,0)
+      CALL SETUSV ('XF',10)
+      CALL SETUSV ('YF',10)
+      CALL NEWFM
+      IERROR = 0
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	     PWRZI TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END