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