1 files changed, 123 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/tests/haftont.f b/sys/gio/ncarutil/tests/haftont.f
new file mode 100644
index 00000000..b4cfe017
--- /dev/null
+++ b/sys/gio/ncarutil/tests/haftont.f
@@ -0,0 +1,123 @@
+      SUBROUTINE THAFTO	(IERROR)
+C
+C LATEST REVISION	 JULY, 1984
+C
+C PURPOSE		 TO PROVIDE A SIMPLE DEMONSTRATION OF
+C			 HAFTON	AND TO TEST HAFTON ON A	SINGLE
+C			 PROBLEM
+C
+C USAGE			 CALL THAFTO (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			   HAFTON TEST SUCCESSFUL  . . . SEE PLOT TO
+C			   VERIFY PERFORMANCE
+C
+C			 IS PRINTED ON UNIT 6.
+C			 IN ADDITION, TWO FRAMES CONTAINING THE
+C			 HALF-TONE PLOT	ARE PRODUCED ON	THE MACHINE
+C			 GRAPHICS DEVICE.  IN ORDER TO DETERMINE IF THE
+C			 TEST WAS SUCCESSFUL, IT IS NECESSARY TO EXAMINE
+C			 THESE PLOTS.
+C
+C PRECISION		 SINGLE
+C
+C REQUIRED LIBRARY	 HAFTON
+C FILES
+C
+C LANGUAGE		 ANSI FORTRAN 77
+C
+C ALGORITHM		 THE FUNCTION
+C			   Z(X,Y) = X +	Y + 1./((X-.1)**2+Y**2+.09)
+C				    -1./((X+.1)**2+Y**2+.09)
+C			 FOR X = -1. TO	+1. IN INCREMENTS OF .1	AND
+C			     Y = -1.2 TO +1.2 IN INCREMENTS OF .1
+C			 IS COMPUTED.
+C			 THAFTO	CALLS SUBROUTINES EZHFTN AND HAFTON TO
+C			 DRAW TWO HALF-TONE PLOTS OF THE ARRAY Z.
+C
+C PORTABILITY		 ANSI STANDARD
+C
+C
+C Z CONTAINS THE VALUES	TO BE PLOTTED.
+C
+C
+      REAL	      Z(21,25)
+C
+C SPECIFY COORDINATES FOR PLOT TITLES.	ON AN ABSTRACT GRID WHERE
+C THE COORDINATES RANGE	FROM 0.0 TO 1.0, THE VALUES TX AND TY
+C DEFINE THE CENTER OF THE LEFT	EDGE OF	THE TITLE STRING.
+C
+      DATA TX/0.0762/, TY/0.9769/
+C
+C SPECIFY SOME ARGUMENT	VALUES FOR ROUTINE HAFTON.
+C FLO CONTAINS THE LOW VALUE DESIGNATION FOR HAFTON, FHI
+C CONTAINS THE HIGH VALUE DESIGNATION FOR HAFTON, NLEV
+C SPECIFIES THE	NUMBER OF UNIQUE LEVELS	BETWEEN	FLO AND	FHI,  THE
+C ABSOLUTE VALUE OF NOPT DETERMINES THE	MAPPING	OF Z ONTO THE
+C INTENSITIES, AND THE SIGN OF NOPT CONTROLS THE DIRECTNESS OR
+C INVERSNESS OF	THE MAPPING.
+C
+      DATA FLO/-4.0/, FHI/4.0/,	NLEV/8/, NOPT/-3/
+C
+C
+      SAVE
+C
+C INITIALIZE ERROR PARAMETER
+C
+      IERROR = 0
+C
+C FILL TWO DIMENSIONAL ARRAY TO	BE PLOTTED
+C
+      DO  20 I=1,21
+	 X = .1*FLOAT(I-11)
+	 DO  10	J=1,25
+	    Y =	.1*FLOAT(J-13)
+	    Z(I,J) = X+Y+1./((X-.10)**2+Y**2+.09)-
+     1		     1./((X+.10)**2+Y**2+.09)
+   10	 CONTINUE
+   20 CONTINUE
+C
+C SELECT NORMALIZATION TRANS 0 FOR PLOTTING TITLE
+C
+c     CALL GSELNT (0)
+C
+C
+C
+C ENTRY	EZHFTN REQUIRES	ONLY THE ARRAY NAME AND	ITS DIMENSIONS
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON
+C
+c     CALL WTSTR (TX,TY,
+c    1		'DEMONSTRATION PLOT FOR ENTRY EZHFTN OF HAFTON',2,0,-1)
+c     CALL EZHFTN (Z,21,25)
+C
+C ENTRY	HAFTON ALLOWS USER SPECIFICATIONS OF PLOT PARAMETERS, IF DESIRED
+C
+C   THE	TITLE FOR THIS PLOT IS
+C
+C     DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON
+C
+      CALL GSELNT (0)
+      CALL WTSTR (TX,TY,
+     1		'DEMONSTRATION PLOT FOR ENTRY HAFTON OF HAFTON',2,0,-1)
+      CALL HAFTON (Z,21,21,25,FLO,FHI,NLEV,NOPT,0,0,0.)
+c     CALL NEWFM
+C
+c     WRITE (6,1001)
+      RETURN
+C
+C
+c1001 FORMAT ('	    HAFTON TEST	SUCCESSFUL',24X,
+c    1	      'SEE PLOT	TO VERIFY PERFORMANCE')
+C
+      END