C
C  FOLLOWING IS A COLLECTION OF SUBROUTINES THAT EXECUTE THE ANSI
C  ESCAPE AND CONTROL SEQUENCES TO PERFORM DIALOGUE SETUP ON A 
C  VT100 CONPATIBLE TEXT TERMINAL.
C
C  NOTE: THE REASON THAT LOGICAL UNIT NUMBER "LUN" IS USED 
C  AS THE I/O CHANNEL IN THESE SUBROUTINES INSTEAD OF THE 
C  DEFAULT FORTRAN LUN "6" IS TO AVOID THE RECURSIVE I/O 
C  WHEN CTRL/Y IS TRAPPED TO CARRY OUT TERMINAL CLEAN UP.
C
     	SUBROUTINE IFANSI_TEXT( STR, N, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS N CHARACTERS OF STR AT LINE --- IL
C	AND COLUMN --- IC
C
C		IC<0 : DISPLAY IN DOUBLE HEIGHT LINE
C		IL<0 : DISPLAY IN DOUBLE WIDTH LINE
C
     	INCLUDE 'TEKLIB.CBS'
    	BYTE TEXT(8), DLIN(3)
     	CHARACTER LINE*132, STR*(*)
     	DATA TEXT / 27, 91, 0, 0, 59, 0, 0, 72 /
    	DATA DLIN / 27, 35, 54 /
C
C  TEXT = <ESC>[00;00H
C  DLIN = <ESC>#6
C
     	N0 = IABS(N)
    	ICD = 0
    	IF( IL.LT.0 ) ICD = 1
    	IF( IC.LT.0 ) ICD = 2
    	ILL = IABS(IL)
    	ICC = IABS(IC)
     	IL0 = ILL/10
     	IL1 = ILL-10*IL0
     	IC0 = ICC/10
     	IC1 = ICC-10*IC0
    	TEXT(3) = 48 + IL0
    	TEXT(4) = 48 + IL1
    	TEXT(6) = 48 + IC0
    	TEXT(7) = 48 + IC1
     	LINE = STR
     	IF( ICD.EQ.0 ) THEN
     	    WRITE(LUN,1) TEXT, LINE(1:N0)
  1	    FORMAT(8A1,A,$)
     	ELSE IF( ICD.EQ.1 ) THEN
     	    WRITE(LUN,2) TEXT,DLIN, LINE(1:N0)
  2	    FORMAT(8A1,3A1,A,$)
     	ELSE
     	    DLIN(3) = 51
    	    WRITE(LUN,2) TEXT,DLIN, LINE(1:N0)
    	    DLIN(3) = 52
    	    ILL = ILL+1
     	    IL0 = ILL/10
     	    IL1 = ILL-10*IL0
    	    TEXT(3) = 48 + IL0
    	    TEXT(4) = 48 + IL1
    	    WRITE(LUN,2) TEXT,DLIN, LINE(1:N0)
    	ENDIF
    	RETURN
     	END

    	SUBROUTINE IFANSI_IFL( KP, IE, IT, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS "IE" INTEGERS CONTAINED IN INTEGER
C	ARRAY -- KP(IE) IN FIELD LENGTH DESIGNATED BY "IT" AT
C	LINE "IL" AND COLUMN "IC".
C	
     	INCLUDE  'TEKLIB.CBS'
    	INTEGER   KP(1)
        CHARACTER FRMT*16, IT*(*)
    	BYTE      TEXT(8)
     	DATA TEXT / 27, 91, 0, 0, 59, 0, 0, 72 /
        DATA FRMT / '(8A1,)' /
C
C  TEXT = <ESC>[00;00H
C
     	IL0=IL/10
     	IL1=IL-10*IL0
     	IC0=IC/10
     	IC1=IC-10*IC0
    	TEXT(3) = 48 + IL0
    	TEXT(4) = 48 + IL1
    	TEXT(6) = 48 + IC0
    	TEXT(7) = 48 + IC1
C
C  VAX-FORTRAN VARIABLE FORMAT IS AVOIDED HERE
C  BECAUSE IT'S FORTRAN-77 STANDARD...
C
        FRMT(6:) = IT
        IR = IFMISC_LENG(FRMT)
        FRMT(IR+1:) = ',$)'
     	WRITE(LUN,FRMT) TEXT, (KP(I),I=1,IE)
    	RETURN
     	END

    	SUBROUTINE IFANSI_FFL( RP, IE, FL, IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE OUTPUTS "IE" REAL NUMBERS CONTAINED IN THE
C	ARRAY -- RP(IE) IN FIELD FORMAT DESIGNATED BY "FL" AT
C	LINE NUMBER "IL" AND COLUMN NUMBER "IC" IN THE DIALOGUE
C	AREA, WHERE "FL" IS SPECIFIED IN CHARACTER LITERALS
C       "wFm.n" OR "wGm.n".
C
     	INCLUDE  'TEKLIB.CBS'
    	REAL      RP(1)
        CHARACTER FRMT*16, FL*(*)
    	BYTE      TEXT(8)
     	DATA TEXT / 27, 91, 0, 0, 59, 0, 0, 72 /
        DATA FRMT / '(8A1,)' /
C
C  TEXT = <ESC>[00;00H
C
     	IL0 = IL/10
     	IL1 = IL-10*IL0
     	IC0 = IC/10
     	IC1 = IC-10*IC0
    	TEXT(3) = 48 + IL0
    	TEXT(4) = 48 + IL1
    	TEXT(6) = 48 + IC0
    	TEXT(7) = 48 + IC1
        FRMT(6:) = FL
        IR = IFMISC_LENG(FRMT)
        FRMT(IR+1:) = ',$)'
     	WRITE(LUN,FRMT) TEXT, (RP(I),I=1,IE)
    	RETURN
     	END

    	SUBROUTINE IFANSI_CLEAR( IC )
C
C   PROGRAMMER: R.S. ZHOU,	FEB-1986
C
C	THIS ROUTINE ERASES THE SCREEN AREA SPECIFIED BY "IC"
C	BY USING THE STANDARD ANSI COMMANDS.
C
C	IC = 0: ERASE THE ENTIRE SCREEN AND CURSOR HOME AT (1,1)
C	IC = 1: ERASE THE ENTIRE SCREEN AND CURSOR DOES NOT MOVE
C	IC = 2: ERASE FROM THE CURRENT CURSOR TO THE END OF SCREEN
C	IC = 3: ERASE FROM THE CURRENT CURSOR TO THE TOP OF SCREEN
C	IC = 4: ERASE FROM THE CURRENT CURSOR TO THE END OF LINE
C	IC = 5: ERASE FROM THE CURRENT CURSOR TO THE START OF LINE
C	IC = 6: ERASE THE ENTIRE LINE OF CURRENT CURSOR.
C
     	INCLUDE 'TEKLIB.CBS'
    	BYTE TEXT(7)
    	DATA TEXT / 27, 91, 0, 0, 27, 91, 72 /

     	IF( IF_DCL_HARDCOPY() ) RETURN

    	II = IC
    	TEXT(4) = 74
    	IF( II.GT.3 ) TEXT(4) = 75
    	TEXT(3) = 50
    	IF( II.EQ.2 .OR. II.EQ. 4 ) TEXT(3) = 48
    	IF( II.EQ.3 .OR. II.EQ. 5 ) TEXT(3) = 49
    	IF( II.EQ.0 ) THEN
       	    WRITE(LUN,1) (TEXT(I),I=1,7)
        ELSE
       	    WRITE(LUN,2) (TEXT(I),I=1,4)
        ENDIF
  1     FORMAT(7A1,$)
  2     FORMAT(4A1,$)
    	RETURN
     	END

    	SUBROUTINE IFANSI_CURSOR( IL, IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE POSITIONS THE ALPHA CURSOR
C
C		AT SCREEN   LINE --- IL
C		AT SCREEN COLUMN --- IC
C
C	IN DIALOGUE AREA BY ANSI CURSOR COMMANDS.
C
C		1<=IL<=30,     1<=IC<=80
C
C	IF IL=0, IC SPECIFIES CURSOR RIGHTWARD/LEFTWARD MOTION;
C	IF IC=0, IL SPECIFIES CURSOR UP/DOWN MOTION:
C
C		POSITIVE NUMBER ===> DOWN/RIGHTWARD
C		NEGATIVE NUMBER ===> UP/LEFTWARD
C
     	INCLUDE 'TEKLIB.CBS'
    	BYTE CUR1(8), CUR2(5)
    	DATA CUR1/ 27, 91, 0, 0, 59, 0, 0, 72 /	!<ESC>[00;00H (POSITION)
    	DATA CUR2/ 27, 91, 0, 0, 0 /		!<ESC>[000    (POSITION)

     	IF( IF_DCL_HARDCOPY() ) RETURN

     	ILL = IABS(IL)
     	IF( ILL.NE.0 ) THEN
     	    IF( ILL.GT.24 ) ILL = 24
     	    IL0 = ILL/10
     	    IL1 = ILL-10*IL0
     	ENDIF
     	ICC = IABS(IC)
     	IF( ICC.NE.0 ) THEN
     	    IF( ICC.GT.80 ) ICC = 80
     	    IC0 = ICC/10
     	    IC1 = ICC-10*IC0
     	ENDIF
     	IF( ILL.NE.0 .AND. ICC.NE.0 ) THEN
     	    CUR1(3) = IL0+48
     	    CUR1(4) = IL1+48
     	    CUR1(6) = IC0+48
     	    CUR1(7) = IC1+48
     	    WRITE(LUN,1) CUR1
  1	    FORMAT(8A1,$)
     	ELSE IF( ILL.EQ.0 ) THEN
     	    CUR2(3) = IC0+48
     	    CUR2(4) = IC1+48
     	    CUR2(5) = 68
     	    IF( IC.GT.0 ) CUR2(5) = 67
     	    WRITE(LUN,1) (CUR2(I),I=1,5)
     	ELSE
     	    CUR2(3) = IL0+48
     	    CUR2(4) = IL1+48
     	    CUR2(5) = 65
     	    IF( IL.GT.0 ) CUR2(5) = 66
     	    WRITE(LUN,1) CUR2
     	ENDIF
    	RETURN
     	END

    	SUBROUTINE IFANSI_VIDEO( IC )
C
C	PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	THIS ROUTINE IMPLEMENTS THE STANDARD ANSI GRAPHICS RENDITIONS
C
C	IC=#*, # = background color 0 to 7
C	       * = character color  0 to 7
C
C	If IC<0, reverse video is on, otherwise off.
C	If *=9 blink on (e.g. IC=9 just blinking)
C	If #=9 underscore on (.e.g. IC=90 just underscore)
C	If #=8 bold display on (.e.g. IC=80 just bold)
C
     	INCLUDE 'TEKLIB.CBS'
     	LOGICAL REVERSE
     	INTEGER CRT
    	BYTE TEXT(5)
    	DATA TEXT / 27, 91, 0, 0, 109 /

     	IF( IF_DCL_HARDCOPY() ) RETURN
C
C   GET TERMINAL ID REPORT...
C
     	CRT = IFINIT_ITM(0)
C
C   TEXT = <ESC>[00m
C
    	IC0 = IC
     	REVERSE = .FALSE.
     	IF( IC0.LT.0 ) REVERSE = .TRUE.
     	IC1 = IABS(IC0)
     	IC0 = IC1/10
     	IC1 = IC1 - IC0*10
     	IF( CRT.NE.2.AND.IC0.NE.4.AND.IC0.LT.8 ) REVERSE = .TRUE.

    	IF( IC0.LT.8 .AND. IC1.LT.8 ) THEN
    	    TEXT(3) = 48
    	    TEXT(4) = 48
     	    WRITE(LUN,1) TEXT  		!ALL ATTRIBUTES OFF
    	ENDIF

     	IF( REVERSE ) THEN
    	    TEXT(3) = 48
    	    TEXT(4) = 55
     	    WRITE(LUN,1) TEXT		!REVERSE VIDEO ON
     	ENDIF

     	IF( CRT.NE.2 .AND. IC0.EQ.8 ) THEN
     	    TEXT(3) = 0
     	    TEXT(4) = 49
     	    WRITE(LUN,1) TEXT		!BOLD PRINT ON
     	ENDIF

     	IF( IC0.EQ.9 ) THEN
     	    TEXT(3) = 0
     	    TEXT(4) = 52
     	    WRITE(LUN,1) TEXT		!UNDERSCORE ON
     	ENDIF

     	IF( IC0.LT.8 .AND. CRT.EQ.2 ) THEN
     	    TEXT(3) = 52
     	    TEXT(4) = 48 + IC0		!BACKGROUND COLOR
     	    WRITE(LUN,1) TEXT
     	ENDIF

     	IF( IC0.GT.7 .AND. IC1.EQ.0 ) GOTO 9

     	IF( IC1.EQ.9 ) THEN
     	    TEXT(3) = 0
     	    TEXT(4) = 53
     	    WRITE(LUN,1) TEXT		!BLINK ON
     	ELSE IF( CRT.EQ.2 ) THEN
     	    TEXT(3) = 51
     	    TEXT(4) = 48 + IC1
     	    WRITE(LUN,1) TEXT		!CHARACTER COLOR
     	ENDIF
  1	FORMAT(5A1,$)
  9    	RETURN
     	END

    	SUBROUTINE IFANSI_MARGIN( ITOP,IBOT )
C
C  PROGRAMMER: R.S. ZHOU
C
C  	THIS ROUTINE SETS TOP AND BOTTOM MARGINS OF SCREEN
C	FOR DIALOG IN ANSI MODE.
C
     	INCLUDE 'TEKLIB.CBS'
    	BYTE TEXT(8)
     	DATA TEXT/ 27, 91, 0, 0, 59, 0, 0, 114 /	!<ESC>[00;00r

     	IF( IF_DCL_HARDCOPY() ) RETURN

    	IT = ITOP
    	IB = IBOT
    	IF( IT.LT.1 ) IT = 1
    	IF( IT.GT.24) IT = 24
    	IF( IB.LT.1 ) IB = 24
    	IF( IB.GT.24) IB = 24
    	IF( IT.GT.(IB-2)) IT = IB-2
     	IT0 = IT/10
     	IT1 = IT-10*IT0
     	IB0 = IB/10
     	IB1 = IB-10*IB0
     	TEXT(3) = IT0+48
     	TEXT(4) = IT1+48
     	TEXT(6) = IB0+48
     	TEXT(7) = IB1+48
     	WRITE(LUN,1) TEXT
 1	FORMAT(8A1,$)
    	RETURN
    	END    	

     	SUBROUTINE IFANSI_TITLE( TITLE )
C
C	THIS ROUTINE DISPLAYS A SCREEN PAGE TITLE.
C
     	CHARACTER HEADER*80, TITLE*(*)
     	HEADER = TITLE
     	HEADER(68:) = 'TIME:'
     	CALL TIME( HEADER(73:80) )
     	CALL IFANSI_VIDEO(12)
     	CALL IFANSI_VIDEO(80)
     	CALL IFANSI_TEXT( HEADER, 80, 1, 1 )
     	CALL IFANSI_VIDEO(47)
     	RETURN
     	END

     	SUBROUTINE IFANSI_ANSI( FLAG )
C
C	THIS ROUTINE SETS ANSI GRAPH FLAG.
C
     	INCLUDE 'TEKLIB.CBS'
     	LOGICAL FLAG
     	IF( ITM.EQ.1 ) ANSI = FLAG
     	RETURN
     	END

     	SUBROUTINE IFANSI_FLAG( FLAG )
     	INCLUDE 'TEKLIB.CBS'
     	LOGICAL FLAG
     	FLAG = ANSI
     	RETURN
     	END

     	SUBROUTINE IFANSI_LAST( IL, IC )
C
C	THIS ROUTINE REPORTS LAST PEN LOCATION
C	AS ALPHA-CURSOR COORDINATE.
C
     	INCLUDE 'TEKLIB.CBS'
     	IL = 3.5*FLOAT(IYL)/FUNI + 0.5
     	IF( IL.LT.1 ) IL = 1
     	IF( IL.GT.24) IL = 24
     	IL = 27-IL		!OFFSET DOWN BY TWO LINES
     	IF( IL.GT.24 ) IL = 24
     	IC = 8.0*FLOAT(IXL)/FUNI + 0.5
     	IF( IC.LT.1 ) IC = 1
     	IF( IC.GT.80) IC = 80
     	RETURN
     	END

     	SUBROUTINE IFANSI_LINE( IL1, IC1, IL2, IC2 )
C
C	THIS ROUTINE DRAWS A LINE SEGMENT.
C
     	CHARACTER VBAR*1, DASH*80
     	DATA VBAR / '|' /
     	DATA DASH(01:40) / '----------------------------------------' /
     	DATA DASH(41:80) / '----------------------------------------' /

     	IF( IC1.NE.IC2 ) THEN
     	    CALL IFANSI_TEXT( DASH, IC2-IC1+1, IL1, IC1 )
     	ELSE
     	    IL3 = 1
     	    IF( IL2.LT.IL1 ) IL3 = -1
     	    DO  I=IL1,IL2,IL3
     		CALL IFANSI_TEXT( VBAR, 1, I, IC1 )
     	    ENDDO
     	ENDIF
     	RETURN
     	END

     	SUBROUTINE IFANSI_DRAW( IC )
C
C	THIS ROUTINE PUTS AN ASCII CHARACTER AT CURRENT PEN LOCATION.
C
     	CHARACTER ASCII*1
     	SAVE KL, KC
     	CALL IFANSI_LAST( JL, JC )
     	IF( JL.EQ.KL .AND. JC.EQ.KC ) RETURN
     	ICC = IABS(IC) + 32
     	IF( ICC.EQ.32 ) ICC = 42		! "*"
     	IF( ICC.GT.125) ICC = 125
     	ASCII = CHAR( ICC )
     	CALL IFANSI_TEXT( ASCII, 1, JL, JC )
     	KL = JL
     	KC = JC
     	RETURN
     	END

     	SUBROUTINE IFANSI_CHAR( XPS, YPS, NCH, TEXT )
     	CHARACTER TEXT*(*)
     	CALL IFINIT_DIF(0)
     	CALL IFPLOT_VECT( XPS, YPS, 3 )
     	CALL IFINIT_DIF(1)
     	CALL IFANSI_LAST( IL, IC )
     	CALL IFANSI_TEXT( TEXT, NCH, IL, IC )
     	RETURN
     	END

     	SUBROUTINE IFANSI_WHERE( IL, IC )
C
C	THIS ROUTINE GETS THE CURRENT ALPHA-CURSOR POSITION
C	AS LINE NUMBER "IL" AND COLUMN NUMBER "IC".
C
     	INCLUDE  'TEKLIB.CBS'
     	CHARACTER REPORT*8
     	WRITE(LUN,1) ESC	!REQUEST A CURSOR POSITION REPORT
  1	FORMAT(A1,'[6n',$)
     	IKEY = IFQIOW( NCHS, REPORT )		!READ THE REPORT
     	IKEY = INDEX( REPORT, ';' )
     	READ(REPORT(2:IKEY-1),2) IL		!GET LINE NUMBER
     	READ(REPORT(IKEY+1:NCHS-1),2) IC	!GET COLUMN NUMBER
  2	FORMAT(I2)
     	RETURN
     	END

     	SUBROUTINE IFANSI_LEDS( LED )
C
C	THIS ROUTINE LIGHTS UP OR CLEARS THE ANSI LEDS.
C
C		LED=0: CLEAR ALL LEDS
C		LED=1: LIGHT UP THE LED #1.
C		LED=2: LIGHT UP THE LED #2.
C		LED=3: LIGHT UP THE LED #3.
C		LED=4: LIGHT UP THE LED #4.
C
     	INCLUDE 'TEKLIB.CBS'
     	IF( LED.GT.-1 .AND. LED.LT.5 ) THEN
     	    WRITE(LUN,1) ESC, LED
  1	    FORMAT(A1,'[',I1,'q',$)
     	ENDIF
     	RETURN
     	END

      SUBROUTINE IFARCS(XOP,YOP,RAD1,RAD2,RAD3,ANGL0,ANGL1,ANGL2,ANGL3)
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE DRAWS AN ARC/CIRCLE/ELLIPSE/PIE/DONUN.
C
C	XOP ------ X-COORDINATE OF THE CENTER IN INCHES.
C	YOP ------ Y-COORDINATE OF THE CENTER IN INCHES.
C	RAD1 ----- RADIUS IN X-DIMENSION IN INCHES.
C	RAD2 ----- RADIUS IN Y-DIMENSION IN INCHES.
C	RAD3 ----- BORDER WIDTH (INWARD) IN INCHES.
C		   IF BORDER=RADIUS, A PIE IS DRAWN.
C	ANGL0 ---- ROTATION ANGLE OF OBJECT IN DEGREES FROM X-AXIS.
C	ANGL1 ---- STARTING ANGLE IN DEGREES TO DRAW THE ARC.
C	ANGL2 ---- ADDITIVE ANGLE IN DEGREES TO ANG1.
C	ANGL3 ---- CHORD ANGLE IN DEGREES [10.0].
C
     	INCLUDE  'TEKLIB.CBS'
     	LOGICAL   PIE

     	IF( ABS(RAD1).LT.0.01 .OR. ABS(RAD2).LT.0.01 ) RETURN
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
C
C  INITIALIZE...
C
     	IDW = 0
     	XPS = XOP
     	YPS = YOP
     	RD1 = ABS(RAD1)
     	RD2 = ABS(RAD2)
     	RD3 = ABS(RAD3)
     	ANG0 = AMOD( ANGL0, 360.0 )
     	ANG1 = AMOD( ANGL1, 360.0 )
     	ANG2 = AMOD( ANGL2, 360.0 ) + ANG1
     	CHORD = 10.0
     	IF( ANGL3.NE.0.0 ) CHORD = ABS(ANGL3)
     	IF( ANG1.EQ.ANG2 ) THEN
     	    ANG1 = 0.0
     	    ANG2 = 360.
     	ENDIF
     	IF( ANG1.GT.ANG2 ) THEN
     	    ANGLE = ANG1
     	    ANG1  = ANG2
     	    ANG2  = ANGLE
     	ENDIF
     	IF( CHORD.GT.(ANG2-ANG1) ) CHORD = 0.5*(ANG2-ANG1)
     	PIE = .FALSE.
     	IF( RD3.GE.RD1 .OR. RD3.GE.RD2 ) THEN
     	    RD3 = 0.0
     	    IF( (ANG2-ANG1).LT.360.0 ) PIE = .TRUE.
     	ENDIF
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	CALL IFPLOT( XPS, YPS, -3 )
C
C  SET ROTATION IT AT ALL...
C
    	IF( ANG0.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANG0+XANG, ANG0+YANG )
     	ENDIF
C
C  START THE DRAWING...
C
     	LOOP = 1
     	IF( RD3.GT.0 ) LOOP = 2
     	DO I = 1, LOOP
     	    IF( I.EQ.1 ) THEN
     		ANG11 = ANG1
     		ANG22 = ANG2
     		ANGIN = CHORD
     	    ELSE
     		ANG11 = ANG2
     		ANG22 = ANG1
     		ANGIN = -CHORD
     		RD1 = RD1 - RD3
     		RD2 = RD2 - RD3
     	    ENDIF
     	    RDD = 1.0/(RD1*RD1)
     	DO  ANGLE = ANG11, ANG22, ANGIN
     	    XPS = RD1*COSD(ANGLE)
      	    YPS = RD2*SQRT(ABS(1.0-XPS*XPS*RDD))
     	    IF( ANGLE.GT.180.0 .OR. ANGLE.LT.0.0 ) YPS = -YPS
     	    IF( ANGLE.NE.ANG11 ) THEN
     		CALL IFPLOT( XPS, YPS, 2 )
     	    ELSE
     		IF( I.EQ.1 ) THEN
     		    IF( PIE ) THEN
     			CALL IFPLOT( 0.0, 0.0, 3 )
     			CALL IFPLOT( XPS, YPS, 2 )
     		    ELSE
     		    	CALL IFPLOT( XPS, YPS, 3 )
     		    ENDIF
     		    XPSL = XPS
     		    YPSL = YPS
     		ELSE
     		    IF( (ANG2-ANG1).LT.360.0 ) THEN
     			CALL IFPLOT( XPS, YPS, 2 )
     		    ELSE
     			CALL IFPLOT( XPS, YPS, 3 )
     		    ENDIF
     		ENDIF
     	    ENDIF
     	ENDDO
     	ENDDO
     	IF(LOOP.EQ.2.AND.(ANG2-ANG1).LT.360.) CALL IFPLOT(XPSL,YPSL,2)
C
C  RESTORE...
C
     	IF( PIE ) CALL IFPLOT( 0.0, 0.0, 2 )
     	IF( ANG0.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XOP, -YOP, -9 )

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) RAD1,RAD2,RAD3, XOP,YOP,
     +                      ANGL0,ANGL1,ANGL2,ANGL3
     	ENDIF
1000	FORMAT('ARCS:',9F8.3)
     	IDW = IWD

999	RETURN
    	END

      	SUBROUTINE IFARCS_CIRCLE( XOP, YOP, SIZ, CHORD )
C
C	THIS ROUTINE DRAWS A SIMPLE CIRCLE.
C
     	INCLUDE  'TEKLIB.CBS'

      	RAD = ABS(SIZ)
     	IF( RAD.LT.0.01 ) RETURN
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
     	IDW = 0
     	XPS = XOP
     	YPS = YOP
     	ANG = 10.0
     	IF( CHORD.GT.0 ) ANG = 360.0/INT(360.0/CHORD)
     	CALL IFPLOT( XPS, YPS, -9 )
        CALL IFPLOT( RAD, 0.0, 3 )
     	DO ANGLE= ANG, 360.0, ANG
     	    XPS = RAD*COSD(ANGLE)
     	    YPS = RAD*SIND(ANGLE)
      	    CALL IFPLOT( XPS, YPS, 2 )
     	ENDDO
     	CALL IFPLOT( -XOP, -YOP, -9 )
888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) RAD, XOP,YOP, CHORD
     	ENDIF
1000	FORMAT('CIRC:',4F8.3)
     	IDW = IWD
999	RETURN
    	END

      	SUBROUTINE IFARCS_ELLP( XOP, YOP, XSIZ, YSIZ, CHORD )
C
C	THIS ROUTINE DRAWS A SIMPLE ELLIPSE.
C
     	INCLUDE  'TEKLIB.CBS'

      	XRD = ABS(XSIZ)
     	IF( XRD.LT.0.01 ) RETURN
      	YRD = ABS(YSIZ)
     	IF( YRD.LT.0.01 ) RETURN
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
     	IDW = 0
     	XPS = XOP
     	YPS = YOP
     	ANG = 10.0
     	IF( CHORD.GT.0 ) ANG = 360.0/INT(360.0/CHORD)
     	CALL IFPLOT( XPS, YPS, -9 )
        CALL IFPLOT( XRD, 0.0, 3 )
     	RDD = 1.0/(XRD*XRD)
     	DO  ANGLE = ANG, 360.0, ANG
     	    XPS = XRD*COSD(ANGLE)
            YPS = YRD*SQRT(ABS(1.0-XPS*XPS*RDD))
     	    IF( ANGLE.GT.180.0 .OR. ANGLE.LT.0.0 ) YPS = -YPS
      	    CALL IFPLOT( XPS, YPS, 2 )
     	ENDDO
     	CALL IFPLOT( -XOP, -YOP, -9 )
888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) XRD,YRD, XOP,YOP, CHORD
     	ENDIF
1000	FORMAT('ELLP:',5F8.3)
     	IDW = IWD
999	RETURN
    	END

    	SUBROUTINE IFARRH( IT, XOP, YOP, WIDTH, HEIGHT, HEAD, ANGLE )
C
C  PROGRMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS AN ARROWHEAD.
C
C	IT --------- TYPE OF ARROWHEAD.
C			 1: SINGLE LINE ARROW (->).
C			11: SINGLE LINE DOUBLE-ARROW (<->).
C			 2: DOUBLE LINE ARROW (=>).
C			22: DOUBLE LINE DOUBLE-ARROW (<=>).
C			 3: CONTOUR ARROWHEAD.
C			33: CONTOUR DOUBLE-ARROWHEAD.
C			 4: SOLID ARROWHEAD.
C			44: SOLID DOUBLE-ARROWHEAD.
C	XOP -------- X-COORDINATE OF HEAD-TIP IN INCHES.
C	YOP -------- Y-COORDINATE OF HEAD-TIP IN INCHES.
C		     FOR A DOUBLE-ARROW, IT'S THE RIGHT TIP.
C	WIDTH ------ WIDTH  OF ARROWHEAD.
C	HEIGHT ----- HEIGHT OF ARROWHEAD.
C	HEAD ------- HEAD-SECTION LENGTH OF ARROWHEAD.
C	ANGLE ------ ROTATION ANGLE IN DEGREES
C		  	ANGLE = 0 OR 360 DEGREE( > )
C		  	ANGLE = 90 DEGREE( ^ )
C		  	ANGLE = 180 DEGREE( < )
C			ANGLE = -90 OR 270 DEGREE( V )
C			INTERMEDIATE ANGLES, OF COUSRE, ARE ALLOWED.
C
     	INCLUDE 'TEKLIB.CBS'
     	LOGICAL TWO

     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
C
C  INITIALIZE...
C
     	IDW = 0
     	ITY = IABS(IT)
     	TWO = .FALSE.
     	IF( ITY.GT.10 ) THEN
     	    ITY = MOD( ITY, 10 )
     	    TWO = .TRUE.
     	ENDIF
     	XPS = XOP
     	YPS = YOP
    	WID = ABS(WIDTH)
     	IF( WID.LT.0.1 ) WID = 0.1
    	HGT = 0.5*ABS(HEIGHT)
     	WDD = ABS(HEAD)
     	IF( .NOT.TWO .AND. WDD.GT.WID ) WDD = WID
     	IF(  TWO .AND. WDD.GT.0.5*WID ) WDD = 0.5*WID
     	ANG = AMOD( ANGLE, 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS)...
C
     	CALL IFPLOT( XPS, YPS, -9 )
     	CALL IFPLOT( 0.0, 0.0,  3 )
C
C  SET THE ROTATION IF AT ALL...
C
    	IF( ANG.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANG+XANG, ANG+YANG )
     	ENDIF
C
C  START THE DRAWING...
C
     	IF( ITY.EQ.1 ) THEN	!SINGLE-LINE ARROW
     	    CALL IFPLOT( -WID, 0.0, 2 )
     	    CALL IFPLOT( -WDD, HGT, 3 )
     	    CALL IFPLOT(  0.0, 0.0, 2 )
     	    CALL IFPLOT( -WDD,-HGT, 2 )
     	    IF( TWO ) THEN
     	    	CALL IFPLOT( -WID+WDD, HGT, 3 )
     	    	CALL IFPLOT(     -WID, 0.0, 2 )
     	    	CALL IFPLOT( -WID+WDD,-HGT, 2 )
     	    ENDIF
     	ELSE IF( ITY.EQ.2 ) THEN	!DOUBLE-LINE ARROW
     	    HHH = 0.34*HGT
     	    WTN = HHH*WDD/HGT
     	    CALL IFPLOT( -WDD, HGT, 2 )
     	    CALL IFPLOT(  0.0, 0.0, 3 )
     	    CALL IFPLOT( -WDD,-HGT, 2 )
     	    IF( .NOT.TWO ) THEN
     	    	CALL IFPLOT( -WID, HHH, 3 )
     	    	CALL IFPLOT( -WTN, HHH, 2 )
     	    	CALL IFPLOT( -WTN,-HHH, 3 )
     	    	CALL IFPLOT( -WID,-HHH, 2 )
     	    ELSE
     	    	CALL IFPLOT( -WID+WDD, HGT, 3 )
     	    	CALL IFPLOT(     -WID, 0.0, 2 )
     	    	CALL IFPLOT( -WID+WDD,-HGT, 2 )
     	    	CALL IFPLOT( -WID+WTN, HHH, 3 )
     	    	CALL IFPLOT(     -WTN, HHH, 2 )
     	    	CALL IFPLOT(     -WTN,-HHH, 3 )
     	    	CALL IFPLOT( -WID+WTN,-HHH, 2 )
     	    ENDIF
     	ELSE IF( ITY.GT.2 ) THEN	!CONTOUR ARROWHEAD
     	    IF( ITY.EQ.4 ) CALL IFFILL(1)	!SOLID ARROWHEAD
     	    WWW = 0.80*WDD
     	    HHH = 0.34*HGT
     	    CALL IFPLOT(  0.0, 0.0, 3 )
     	    CALL IFPLOT( -WDD, HGT, 2 )
     	    CALL IFPLOT( -WWW, HHH, 2 )
     	    IF( .NOT.TWO ) THEN
     	    	CALL IFPLOT( -WID, HHH, 2 )
     	    	CALL IFPLOT( -WID,-HHH, 2 )
     	    ELSE
     	    	CALL IFPLOT( -WID+WWW, HHH, 2 )
     	    	CALL IFPLOT( -WID+WDD, HGT, 2 )
     		CALL IFPLOT(     -WID, 0.0, 2 )
     	    	CALL IFPLOT( -WID+WDD,-HGT, 2 )
     	    	CALL IFPLOT( -WID+WWW,-HHH, 2 )
     	    ENDIF
     	    CALL IFPLOT( -WWW,-HHH, 2 )
     	    CALL IFPLOT( -WDD,-HGT, 2 )
     	    CALL IFPLOT(  0.0, 0.0, 2 )
     	    IF( ITY.EQ.4 ) CALL IFFILL(0)	!SOLID ARROWHEAD
     	ENDIF
C
C  RESTORE...
C
    	IF( ANG.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XOP, -YOP, -9 )

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) IT,WIDTH,HEIGHT,HEAD,XOP,YOP,ANGLE
     	ENDIF
1000	FORMAT('ARRH:',I3,6F8.3)
     	IDW = IWD

999	RETURN
    	END

    	SUBROUTINE IFAXIS( ITY, XLN, YLN, TXT, FST, DEL,
     +                     DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: 	RONG-SHENG ZHOU
C		ALFRED UNIVERSITY, 8/1986
C
C	THIS ROUTINE DRAWS AN AXIS AT ACTIVE GRAPH ORIGIN.
C
C	ITY --- AXIS TYPE:
C
C		1: LINEAR X-AXIS.
C		2: INVERSE-LINEAR X-AXIS.
C		3: LOG10 X-AXIS.
C		4: LINEAR Y-AXIS.
C		5: INVERSE-LINEAR Y-AXIS.
C		6: LOG10 Y-AXIS.
C
    	CHARACTER TXT*(*)

    	IF( ITY.EQ.1 ) THEN
     	    CALL IFAXIS_X1( XLN, YLN, TXT, FST, DEL,
     +                      DST, NTK, MTK, NDG, IGD )
     	ELSE IF( ITY.EQ.2 ) THEN
     	    CALL IFAXIS_X2( XLN, YLN, TXT, FST, DEL,
     +                      DST, NTK, MTK, NDG, IGD )
     	ELSE IF( ITY.EQ.3 ) THEN
     	    CALL IFAXIS_X3( XLN, YLN, TXT, FST, DEL,
     +                      DST, NTK, MTK, NDG, IGD )
     	ELSE IF( ITY.EQ.4 ) THEN
     	    CALL IFAXIS_Y1( XLN, YLN, TXT, FST, DEL,
     +                      DST, NTK, MTK, NDG, IGD )
     	ELSE IF( ITY.EQ.5 ) THEN
     	    CALL IFAXIS_Y2( XLN, YLN, TXT, FST, DEL,
     +                      DST, NTK, MTK, NDG, IGD )
     	ELSE IF( ITY.EQ.6 ) THEN
     	    CALL IFAXIS_Y3( XLN, YLN, TXT, FST, DEL,
     +                      DST, NTK, MTK, NDG, IGD )
     	ENDIF
     	RETURN
 	END

    	SUBROUTINE IFAXIS_X1( XLN, YLN, TXT, FST, DEL,
     +                        DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS A LINEAR X-AXIS AT ACTIVE GRAPH ORIGIN.
C
C	XLN --- X-AXIS LENGTH IN CURRENT UNITS.
C		IF XLN<0.0, AXIS ANNOTATION IS ABOVE THE AXIS.
C	YLN --- Y-AXIS LENGTH IN CURRENT UNITS.
C	TXT --- AXIS TITLE IN CHARACTER FORMAT.
C		IF TXT(1)="!", TITLE IS NOT CENTERED ON AXIS.
C	FST --- SCALE VALUE AT THE FIRST MAJOR TICKMARK.
C	DEL --- CHANGE IN SCALE UNITS BETWEEN MAJOR TICKMARKS.
C	DST --- DISTANCE OF FIRST TICKMARK AWAY FROM ORIGIN.
C 	NTK --- NUMBER OF DIVISIONS ON THE AXIS.
C 	MTK --- NUMBER OF MINOR TICKMARKS ON THE AXIS.
C		IF MTK<0, TICKMARKS TO THE SAME SIDE OF ANNOTATIONS.
C	NDG --- NUMBER OF SIGNIFICANT DIGITS FOR SCALE NUMBERS.
C		0 = ROUTINE DETERMINED, 9=NO ANNOTATION.
C		0<= SKIP DRAWING THE MULTIPLIER.
C	IGD --- AXIS PATTERN CODE:
C		1: DRAW THE AXIS WITH MAJOR AND MINOR TICKS.
C		2: DRAW THE AXIS WITH MAJOR TICK ONLY.
C		3: DRAW THE AXIS WITH GRID LINES ON MAJOR TICKS.
C		4: DRAW THE AXIS WITH GRID LINES ON MINOR TICKS AS WELL.
C	MINUS IGD: DRAW THE AXIS WITH ARROWHEAD.
C	 DUAL IGD: DRAW THE OPPOSITE AXIS OF THE SAME PATTERN.
C
     	INCLUDE 'TEKLIB.CBS'
    	CHARACTER TXT*(*)
     	LOGICAL   PAIR, VT100
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C ) RETURN
    	XLEN = ABS(XLN)
    	IGRD = IABS(IGD)
    	PAIR = .FALSE.
     	VT100= .FALSE.
    	IF( IGRD.GT.10 ) THEN
    	    IGRD = MOD( IGRD, 10 )
    	    IF( IGRD.LT.1 ) IGRD = 1
    	    PAIR = .TRUE.
    	ENDIF
    	DIST = DST
    	FIRST= FST
    	DELL = DEL
    	NTIK = IABS(NTK)+1
    	MTIK = IABS(MTK)
    	XAD  = (XLEN-2.0*DIST)/ (NTIK-1)
    	IEX  = 0
     	CALL IFAXIS_DIGITS( NDG, NTIK, FIRST, DELL,
     +                      NDIGIT, IEX, XVL, ADX )
    	IF( IABS(NDG).EQ.9 ) GOTO 222
C
C  PUT ON THE SCALE NUMBERS...
C
     	YM = -0.25
    	IF( XLN.LT.0.0 ) YM = 0.125
     	SIZE = 0.1
    	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
C
C  DETERMINE THE LENGTH OF XVL...
C
    	   IF( ABS(XVL).GE.1.0 ) THEN
    	       NDT = LOG10(ABS(XVL))
    	       NDT = NDT + 1
    	   ELSE
    	       NDT = 1
    	   ENDIF
    	   IF( NDIGIT.GT.0 ) NDT = NDT + NDIGIT + 1
    	   IF( XVL.LT.0.0 ) NDT = NDT + 1
    	   XN = DIST - 0.5*SIZE*NDT + XAD*(I-1)
     	   CALL IFTEXT_FPN( XN, YM, SIZE, XVL, 0.0, NDIGIT )
    	   XVL = XVL + ADX
    	ENDDO
C
C  DRAW TICKMARKS OR GRID LINES...
C
  222	IF( IGRD.LT.4 ) THEN
     	    DYB = 0.08
    	    IF( MTK.LT.0 ) DYB = -0.08
    	    IF( XLN.LT.0.0 ) DYB = -DYB
     	    IF( IGRD.EQ.2 ) THEN
     		MTIK = 0
     	    ELSE
     		DYC = 0.65*DYB
     	    ENDIF
     	ENDIF
     	IF( IGRD.GT.2 ) THEN
     	    DYB = YLN
    	    IF( IGRD.EQ.4 ) DYC = YLN
    	ENDIF
     	XD = XAD
    	IF( MTIK.GT.0 ) XD = XAD / (MTIK+1)
     	XD = -XD
     	XN = XLEN-DIST
    	IF( MTIK.GT.0 .AND. DIST.GT.0.1 ) THEN
    	    NTIK = NTIK + 2
    	    XN = XN+XAD
    	ENDIF
     	XB = -0.005
     	XE = XLEN+0.005
     	YM = 0.0
     	IF( IGRD.EQ.4 ) CALL IFSTYL(2,0)
     	IF( ANSI ) CALL IFAXIS_ANSI( 0.0, 0.0, XLEN, 0.0 )
333	ADX = XN
     	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
     	    IF( ADX.LT.XB ) GOTO 444
     	    IF( ADX.LT.XE ) THEN
     		IF( IGRD.EQ.3 ) CALL IFSTYL(2,0)
     		CALL IFPLOT (ADX,YM,3)
     		IF( ANSI .AND. .NOT.VT100 ) CALL IFANSI_DRAW( 11 )
     		CALL IFPLOT (ADX,DYB,2)
     		IF( IGRD.EQ.3 ) CALL IFSTYL(1,0)
     	    ENDIF
     	    DO  K=1, MTIK
     		ADX = ADX + XD
     		IF( ADX.LT.XB ) GOTO 444
     		IF( ADX.LT.XE ) THEN
     		    CALL IFPLOT (ADX,YM,3)
     		    CALL IFPLOT (ADX,DYC,2)
     		ENDIF
     	    ENDDO
     	    ADX = ADX + XD
     	ENDDO
444	IF( IGRD.EQ.4 ) CALL IFSTYL(1,0)
     	CALL IFPLOT (0.0,YM,3)
    	CALL IFPLOT (XLEN,YM,2)
     	IF(IGD.LT.0.AND.DELL.GT.0.0) CALL IFARRH( 1, XLEN+0.25,
     +  YM, 0.25, 0.04, 0.15, 0.0 )
    	IF( .NOT.PAIR ) GOTO 555
C
C  DRAW THE OPPOSITE AXIS...
C
     	YM = YLN
     	PAIR = .FALSE.
     	VT100= .TRUE.
     	IF( IGRD.EQ.4 ) GOTO 444
     	IF( IGRD.EQ.3 ) DYB = 0.0
     	DYB = YLN - DYB
     	DYC = YLN - DYC
     	GOTO 333
C
C  DRAW THE TITLE AND MAGNITUDE INDICATOR...
C
555	CALL IFAXIS_XLABEL(TXT,XLN,NDG,IEX)
     	RETURN
     	END

    	SUBROUTINE IFAXIS_X2( XLN, YLN, TXT, FST, DEL,
     +                        DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C     THIS ROUTINE DRAWS A LOG10 X-AXIS AT ACTIVE GRAPH ORIGIN.
C
C	XLN --- X-AXIS LENGTH IN CURRENT UNITS.
C		IF XLN<0.0, AXIS ANNOTATION IS ABOVE THE AXIS.
C	YLN --- Y-AXIS LENGTH IN CURRENT UNITS.
C	TXT --- AXIS TITLE IN CHARACTER FORMAT.
C		IF TXT(1)="!", TITLE IS NOT CENTERED ON AXIS.
C	FST --- SCALE VALUE AT THE FIRST MAJOR TICKMARK.
C 	DEL --- LOG CYCLES ON THE AXIS = MAJOR TICKMARK - 1.
C	DST --- DISTANCE OF FIRST TICKMARK AWAY FROM ORIGIN.
C 	NTK --- NUMBER OF DIVISIONS ON THE AXIS (NOT USED).
C 	MTK --- NUMBER OF MINOR TICKMARKS ON THE AXIS (NOT USED).
C		IF MTK<0, TICKMARKS TO THE SAME SIDE OF ANNOTATIONS.
C	NDG --- NUMBER OF SIGNIFICANT DIGITS FOR SCALE NUMBERS.
C		9=SKIP DRAWING THE SCALE UNMBERS.
C
C	IGD --- AXIS PATTERN CODE:
C
C		1: DRAW THE AXIS WITH MAJOR AND MINOR SCALE NUMBERS.
C		2: DRAW THE AXIS WITH MAJOR SCALE NUMBERS ONLY.
C		3: DRAW THE AXIS WITH GRID LINES ON MAJOR TICKS.
C		4: DRAW THE AXIS WITH GRID LINES ON MINOR TICKS AS WELL.
C	 DUAL IGD: DRAW THE OPPOSITE AXIS OF THE SAME PATTERN.
C	
     	INCLUDE		'TEKLIB.CBS'
    	CHARACTER	TXT*(*)
    	DIMENSION	BLOG(9)
     	LOGICAL		PAIR, VT100
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C ) RETURN
    	XLEN = ABS(XLN)
    	IGRD = IABS(IGD)
    	PAIR = .FALSE.
     	VT100= .FALSE.
    	IF( IGRD.GT.10 ) THEN
    	    IGRD = IGRD / 10
    	    IF( IGRD.LT.1 ) IGRD = 1
    	    PAIR = .TRUE.
    	ENDIF
    	FIRST = LOG10(FST)
    	SIGN  = 1.0
    	DELL  = DEL
    	DIST  = DST
    	XDD   = 0.05
    	XXD   = 0.02
    	IF( DELL.LT.0.0 ) THEN
    	    FIRST= FIRST + DELL
    	    XDD  = 0.15
    	    XXD  = 0.12
    	ENDIF
    	NTIC = ABS(DELL) + 1.0
C
C  STORE LOG10S OF INTEGERS 1-9...
C
    	DO I=1,9
    	   BLOG(I) = LOG10(FLOAT(I))
    	ENDDO
C
C  DETERMINE THE DELTA VALUE OF LOG10 CYCLES PER INCH...
C
    	DELTA = DELL / (XLEN-2.0*DIST)
    	DELL  = ABS(DELTA)
    	IF( DELL.GT.0.5 ) THEN
    	    XDD = 0.125
    	    XXD = 0.095
    	ENDIF
C
C  IF CYCLE LENGTH < 1.0 INCH, REDUCE THE NUMBER OF MAJOR TICKS...
C
    	IC = INT( 0.5*DELL ) + 1
C
C  PUT ON THE SCALING NUMBERS...
C
    	IF( IGRD.EQ.2 ) THEN
    	    ITC = 1
    	ELSE
    	    IF( DELL.LE.0.25 ) ITC = 9
    	    IF( DELL.GT.0.25 ) ITC = 9-INT((DELL-0.25)/0.1)
    	    IF( ITC.LT.1 ) ITC = 1
    	ENDIF
    	YAD = -0.25
    	YM  = 0.075
    	IF( XLN.LT.0.0 ) THEN
    	    YM = -0.025
    	    YAD = 0.125
    	ENDIF
    	XN = DIST
     	IF( DELTA.LT.0.0 ) XN = XLEN-DIST
    	IF( IGRD.NE.2 .AND. DIST.GT.0.1 ) THEN
    	    NTIC = NTIC + 2
    	    FIRST= FIRST-1.0
    	    XN = XN - 1.0/DELTA
    	ENDIF
     	XB = -0.005
     	XE = XLEN+0.005
   	IF( IABS(NDG).EQ.9 ) GOTO 222
     	SIZE = 0.1
     	SEXT = 0.06
     	VT100 = ANSI
     	ANSI  = .FALSE.
    	DO MJ = 1, NTIC, IC
     	IF( CTRL_C ) RETURN
    	    FMJ = MJ - 1
    	    EX  = FIRST + FMJ
    	    DO  MI = 1, ITC
     		XAD = XN + (BLOG(MI)+FMJ)/DELTA
     		IF( XAD.GT.XB .AND. XAD.LT.XE ) THEN
     		    XAD = XAD - XDD
     		    IF( MI.EQ.1 ) THEN
     	CALL IFTEXT( XAD, YAD, '10', SIZE, SIZE, 0.0 )
     	CALL IFTEXT_FPN( XAD+2*SIZE, YAD+0.8*SIZE, SEXT, EX, 0.0, -1 )
     			IF( VT100 ) CALL IFAXIS_LOG10( XAD, YAD, EX )
     		    ELSE
     	CALL IFTEXT_FPN( XAD+XXD, YAD+YM, SEXT, FLOAT(MI), 0.0, -1 )
     		    ENDIF
     		ENDIF
     	    ENDDO
     	ENDDO
     	ANSI = VT100
     	VT100= .FALSE.
C
C  DRAW THE TICKMARKS ON THE AXIS...
C
  222	ITC = 9
    	IF( IC.GT.1 ) ITC = 1
     	DYB = 0.08
    	IF( MTK.LT.0.0 ) DYB = -0.08
    	IF( XLN.LT.0.0 ) DYB = -DYB
    	DYC = 0.65*DYB
    	IF( IGRD.GT.2 ) DYB = YLN
    	IF( IGRD.EQ.4 ) DYC = YLN
     	YM = 0.0
     	IF( IGRD.EQ.4 ) CALL IFSTYL(2,0)
     	IF( ANSI ) CALL IFAXIS_ANSI( 0.0, 0.0, XLEN, 0.0 )
  333	DO MJ= 1, NTIC
     	IF( CTRL_C ) RETURN
    	    FMJ = MJ - 1
    	    DO  MI= 1, ITC
     		XAD = XN + (BLOG(MI)+FMJ)/DELTA
     		IF( XAD.GT.XB .AND. XAD.LT.XE ) THEN
     		    IF( MI.EQ.1 ) THEN
     			IF( IGRD.EQ.3 ) CALL IFSTYL(2,0)
     			CALL IFPLOT (XAD,YM,3)
     		IF( ANSI.AND..NOT.VT100 ) CALL IFANSI_DRAW(11)
     			CALL IFPLOT (XAD,DYB,2)
     			IF( IGRD.EQ.3 ) CALL IFSTYL(1,0)
     		    ELSE IF( DELL.LT.2.0 ) THEN
     			CALL IFPLOT (XAD,YM,3)
     			CALL IFPLOT (XAD,DYC,2)
     		    ENDIF
     		ENDIF
     	    ENDDO
     	ENDDO
444	IF( IGRD.EQ.4 ) CALL IFSTYL(1,0)
     	IF(IGD.LT.0.AND.DELTA.GT.0.0) CALL IFARRH( 1, XLEN+0.25,
     +  YM, 0.25, 0.04, 0.15, 0.0 )
    	CALL IFPLOT (XLEN,YM,3)
    	CALL IFPLOT (0.0,YM,2)
    	IF( .NOT.PAIR ) GOTO 555
C
C  DRAW THE OPPOSITE AXIS...
C
     	YM = YLN
     	PAIR = .FALSE.
     	VT100= .TRUE.
    	IF( IGRD.EQ.4 ) GOTO 444
    	IF( IGRD.EQ.3 ) DYB = 0.0
     	DYB = YLN-DYB
     	DYC = YLN-DYC
     	GOTO 333
C
C  DRAW THE AXIS TITLE IF AT ALL...
C
555	CALL IFAXIS_XLABEL(TXT,XLN,NDG,0)
     	RETURN
    	END

    	SUBROUTINE IFAXIS_X3( XLN, YLN, TXT, FST, DEL,
     +                        DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS AN INVERSE-LINEAR X-AXIS AT ACTIVE GRAPH ORIGIN.
C
C	XLN --- X-AXIS LENGTH IN CURRENT UNITS.
C		IF XLN<0.0, AXIS ANNOTATION IS ABOVE THE AXIS.
C	YLN --- Y-AXIS LENGTH IN CURRENT UNITS.
C	TXT --- AXIS TITLE IN CHARACTER FORMAT.
C		IF TXT(1)="!", TITLE IS NOT CENTERED ON AXIS.
C	FST --- SCALE VALUE AT THE FIRST MAJOR TICKMARK.
C	DEL --- CHANGE IN SCALE UNITS BETWEEN MAJOR TICKMARKS.
C	DST --- DISTANCE OF FIRST TICKMARK AWAY FROM ORIGIN.
C 	NTK --- NUMBER OF DIVISIONS ON THE AXIS.
C 	MTK --- NUMBER OF MINOR TICKMARKS ON THE AXIS.
C		IF MTK<0, TICKMARKS TO THE SAME SIDE OF ANNOTATIONS.
C	NDG --- NUMBER OF SIGNIFICANT DIGITS FOR SCALE NUMBERS.
C		0 = ROUTINE DETERMINED, 9=NO ANNOTATION.
C		0<= SKIP DRAWING THE MULTIPLIER.
C	IGD --- AXIS PATTERN CODE:
C		1: DRAW THE AXIS WITH MAJOR AND MINOR TICKS.
C		2: DRAW THE AXIS WITH MAJOR TICK ONLY.
C		3: DRAW THE AXIS WITH GRID LINES ON MAJOR TICKS.
C		4: DRAW THE AXIS WITH GRID LINES ON MINOR TICKS AS WELL.
C	MINUS IGD: DRAW THE AXIS WITH ARROWHEAD.
C	 DUAL IGD: DRAW THE OPPOSITE AXIS OF THE SAME PATTERN.
C	
     	INCLUDE		'TEKLIB.CBS'
    	CHARACTER	TXT*(*)
     	LOGICAL		PAIR, VT100
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C ) RETURN
    	XLEN = ABS(XLN)
    	IGRD = IABS(IGD)
    	PAIR = .FALSE.
     	VT100= .FALSE.
    	IF( IGRD.GT.10 ) THEN
    	    IGRD = MOD( IGRD, 10 )
    	    IF( IGRD.LT.1 ) IGRD = 1
    	    PAIR = .TRUE.
    	ENDIF
    	DIST = DST
    	FIRST= FST
    	DELL = DEL
    	NTIK = IABS(NTK)+1
    	MTIK = IABS(MTK)
C
C  DETERMINE THE LENGTH OF SCALING NUMBERS...
C
    	IEX  = 0
     	CALL IFAXIS_DIGITS( NDG, NTIK, FIRST, DELL,
     +                      NDIGIT, IEX, XVL, ADX )
     	XAD = XVL + (NTIK-1)*ADX
    	XAD = (1.0/XAD-1.0/XVL)/(XLEN-2.0*DIST)
    	IF( IABS(NDG).EQ.9 ) GOTO 222
C
C  PUT ON THE SCALE NUMBERS...
C
     	YM = -0.25
    	IF( XLN.LT.0.0 ) YM = 0.125
     	XVV = XVL
    	XDA = 1.0/XVL
     	SIZE = 0.1
    	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
C
C  DETERMINE THE LENGTH OF XVL...
C
    	   IF( ABS(XVV).GE.1.0 ) THEN
    	       NDT = LOG10(ABS(XVV))
    	       NDT = NDT + 1
    	   ELSE
    	       NDT = 1
    	   ENDIF
    	   IF( NDIGIT.GT.0 ) NDT = NDT + NDIGIT + 1
    	   IF( XVV.LT.0.0 ) NDT = NDT + 1
    	   XN = DIST-0.5*SIZE*NDT+(1.0/XVV-XDA)/XAD
     	   CALL IFTEXT_FPN( XN, YM, SIZE, XVV, 0.0, NDIGIT )
    	   XVV = XVV + ADX
    	ENDDO
C
C  DRAW THE TICKMARKS OR GRID LINES...
C
  222	IF( IGRD.LT.4 ) THEN
     	    DYB = 0.08
    	    IF( MTK.LT.0 ) DYB = -0.08
    	    IF( XLN.LT.0.0 ) DYB = -DYB
     	    IF( IGRD.EQ.2 ) THEN
     		MTIK = 0
     	    ELSE
     		DYC = 0.65*DYB
     	    ENDIF
     	ENDIF
     	IF( IGRD.GT.2 ) THEN
     	    DYB = YLN
    	    IF( IGRD.EQ.4 ) DYC = YLN
    	ENDIF
     	XDA = ADX
    	IF( MTIK.GT.0 ) XDA = ADX / (MTIK+1)
     	XN = DIST
     	XB = -0.005
     	XE = XLEN+0.005
     	YM = 0.0
     	IF( IGRD.EQ.4 ) CALL IFSTYL(2,0)
     	IF( ANSI ) CALL IFAXIS_ANSI( 0.0, 0.0, XLEN, 0.0 )
333	XVV = XVL
    	XV1 = 1.0/XVL
     	ADX = XN
    	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
     	    IF( ADX.GT.XE ) GOTO 444
    	    IF( ADX.GT.XB ) THEN
     		IF( IGRD.EQ.3 ) CALL IFSTYL(2,0)
     		CALL IFPLOT (ADX,YM,3)
     		IF( ANSI.AND..NOT.VT100 ) CALL IFANSI_DRAW(11)
     		CALL IFPLOT (ADX,DYB,2)
     		IF( IGRD.EQ.3 ) CALL IFSTYL(1,0)
     	    ENDIF
     	    DO  K=1, MTIK
     		XVV = XVV + XDA
     		ADX = XN + (1.0/XVV-XV1)/XAD
     		IF( ADX.GT.XE ) GOTO 444
     		IF( ADX.GT.XB ) THEN
     		    CALL IFPLOT (ADX,YM,3)
     		    CALL IFPLOT (ADX,DYC,2)
     		ENDIF
     	    ENDDO
     	    XVV = XVV + XDA
     	    ADX = XN + (1.0/XVV-XV1)/XAD
     	ENDDO

444	IF( IGRD.EQ.4 ) CALL IFSTYL(1,0)
     	CALL IFPLOT (0.0,YM,3)
    	CALL IFPLOT (XLEN,YM,2)
     	IF(IGD.LT.0.AND.DELL.GT.0.0) CALL IFARRH( 1, XLEN+0.25,
     +  YM, 0.25, 0.04, 0.15, 0.0 )
    	IF( .NOT.PAIR ) GOTO 555
C
C  DRAW THE OPPOSITE AXIS...
C
     	YM = YLN
     	PAIR = .FALSE.
     	VT100= .TRUE.
    	IF( IGRD.EQ.4 ) GOTO 444
     	IF( IGRD.EQ.3 ) DYB = 0.0
     	DYB = YLN-DYB
     	DYC = YLN-DYC
     	GOTO 333
C
C  DRAW THE TITLE AND MAGNITUDE INDICATOR...
C
555	CALL IFAXIS_XLABEL(TXT,XLN,NDG,IEX)

     	RETURN
    	END

     	SUBROUTINE IFAXIS_Y1( XLN, YLN, TXT, FST, DEL,
     +                        DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS A LINEAR Y-AXIS AT ACTIVE GRAPH ORIGIN.
C
C	XLN --- X-AXIS LENGTH IN INCHES.
C	YLN --- Y-AXIS LENGTH IN INCHES.
C		IF YLN<0.0, AXIS ANNOTATION IS TO THE RIGHT OF AXIS.
C	TXT --- AXIS TITLE IN CHARACTER FORMAT.
C		IF TXT(1)="!", TITLE IS NOT CENTERED ON AXIS.
C		IF TXT(1)="^", TITLE IS PLACED ON TOP OF AXIS.
C	FST --- SCALE VALUE AT THE FIRST MAJOR TICKMARK.
C	DEL --- CHANGE IN SCALE UNITS BETWEEN MAJOR TICKMARKS.
C	DST --- DISTANCE OF FIRST TICKMARK AWAY FROM ORIGIN.
C 	NTK --- NUMBER OF DIVISIONS ON THE AXIS.
C 	MTK --- NUMBER OF MINOR TICKMARKS ON THE AXIS.
C		IF MTK<0, TICKMARKS TO THE SAME SIDE OF ANNOTATIONS.
C	NDG --- NUMBER OF SIGNIFICANT DIGITS FOR SCALE NUMBERS.
C		0 = ROUTINE DETERMINED, 9=NO ANNOTATION.
C		0<= SKIP DRAWING THE MULTIPLIER.
C	IGD --- AXIS PATTERN CODE:
C		1: DRAW THE AXIS WITH MAJOR AND MINOR TICKS.
C		2: DRAW THE AXIS WITH MAJOR TICK ONLY.
C		3: DRAW THE AXIS WITH GRID LINES ON MAJOR TICKS.
C		4: DRAW THE AXIS WITH GRID LINES ON MINOR TICKS AS WELL.
C	MINUS IGD: DRAW THE AXIS WITH ARROWHEAD.
C	 DUAL IGD: DRAW THE OPPOSITE AXIS OF THE SAME PATTERN.
C	
     	INCLUDE		'TEKLIB.CBS'
    	CHARACTER	TXT*(*)
     	LOGICAL		PAIR, VT100
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C ) RETURN
    	YLEN = ABS(YLN)
    	IGRD = IABS(IGD)
    	PAIR = .FALSE.
     	VT100= .FALSE.
    	IF( IGRD.GT.10 ) THEN
    	    IGRD = MOD( IGRD, 10 )
    	    IF( IGRD.LT.1 ) IGRD = 1
    	    PAIR = .TRUE.
    	ENDIF
    	FIRST= FST
    	DELL = DEL
    	DIST = DST
    	NTIK = IABS(NTK)+1
    	MTIK = IABS(MTK)
    	YAD  = (YLEN-2.0*DIST) / (NTIK-1)
C
C  DETERMINE THE LENGTH OF SCALING NUMBERS...
C
    	IEX  = 0
     	CALL IFAXIS_DIGITS( IABS(NDG), NTIK, FIRST, DELL,
     +                      NDIGIT, IEX, YVL, ADY )
    	NMAX = 0
    	IF( IABS(NDG).EQ.9 ) GOTO 222
C
C  PUT ON THE SCALE NUMBERS...
C
     	SIZE= 0.1
     	YN  = DIST-0.5*SIZE
    	XM  = 0.125
    	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
C
C  DETERMINE THE LENGTH OF YVL...
C
    	   IF( ABS(YVL).GE.1.0 ) THEN
    	       NDT = LOG10(ABS(YVL))
    	       NDT = NDT + 1
    	   ELSE
    	       NDT = 1
    	   ENDIF
    	   IF( NDIGIT.GT.0 ) NDT  = NDT + NDIGIT + 1
    	   IF(  YVL.LT.0.0 ) NDT  = NDT + 1
    	   IF( NDT.GT.NMAX ) NMAX = NDT
    	   IF( YLN.GT.0.0 ) XM = -SIZE*(NDT+1)
    	   YYD = 0.0
     	   IF( DIST.EQ.0.0 ) THEN
    	       IF( I.EQ.NTIK ) YYD = -0.05
    	       IF( I.EQ. 1   ) YYD =  0.05
     	   ENDIF
     	   CALL IFTEXT_FPN( XM, YN+YYD, SIZE, YVL, 0.0, NDIGIT )
    	   YVL = YVL + ADY
    	   YN  = YN  + YAD
    	ENDDO
C
C  DRAW THE TICK MARKS OR GRID LINES...
C
  222	IF( IGRD.LT.4 ) THEN
     	    DYB = 0.08
    	    IF( MTK.LT.0 ) DYB = -0.08
    	    IF( YLN.LT.0.0 ) DYB = -DYB
     	    IF( IGRD.EQ.2 ) THEN
     		MTIK = 0
     	    ELSE
     		DYC = 0.65*DYB
     	    ENDIF
     	ENDIF
     	IF( IGRD.GT.2 ) THEN
     	    DYB = XLN
    	    IF( IGRD.EQ.4 ) DYC = XLN
    	ENDIF
     	YYD = YAD
    	IF( MTIK.GT.0 ) YYD = YAD / (MTIK+1)
     	YYD = -YYD
     	YN = YLEN-DIST
    	IF( MTIK.GT.0 .AND. DIST.GT.0.1 ) THEN
    	    NTIK = NTIK + 2
    	    YN = YN + YAD
    	ENDIF
     	YB = -0.005
     	YE = YLEN+0.005
     	XM = 0.0
     	IF( IGRD.EQ.4 ) CALL IFSTYL(2,0)
     	IF( ANSI ) CALL IFAXIS_ANSI( 0.0, 0.0, 0.0, YLEN )
333	ADY = YN
     	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
     	    IF( ADY.LT.YB ) GOTO 444
     	    IF( ADY.LT.YE ) THEN
     		IF( IGRD.EQ.3 ) CALL IFSTYL(2,0)
     		CALL IFPLOT (XM,ADY,3)
     		IF( ANSI .AND. .NOT.VT100 ) CALL IFANSI_DRAW( 11 )
     		CALL IFPLOT (DYB,ADY,2)
     		IF( IGRD.EQ.3 ) CALL IFSTYL(1,0)
     	    ENDIF
     	    DO  K=1, MTIK
     		ADY = ADY + YYD
     		IF( ADY.LT.YB ) GOTO 444
     		IF( ADY.LT.YE ) THEN
     		    CALL IFPLOT (XM,ADY,3)
     		    CALL IFPLOT (DYC,ADY,2)
     		ENDIF
     	    ENDDO
     	    ADY = ADY + YYD
     	ENDDO
444	IF( IGRD.EQ.4 ) CALL IFSTYL(1,0)
     	CALL IFPLOT (XM,0.0,3)
    	CALL IFPLOT (XM,YLEN,2)
     	IF(IGD.LT.0.AND.DELL.GT.0.0) CALL IFARRH( 1, XM,
     +  YLEN+0.25, 0.25, 0.04, 0.15, 90.0 )
    	IF( .NOT.PAIR ) GOTO 555
C
C  DRAW THE OPPOSITE AXIS...
C
     	XM = XLN
     	PAIR = .FALSE.
     	VT100= .TRUE.
     	IF( IGRD.EQ.4 ) GOTO 444
     	IF( IGRD.EQ.3 ) DYB = 0.0
     	DYB = XLN - DYB
     	DYC = XLN - DYC
     	GOTO 333
C
C  DRAW THE TITLE AND MAGNITUDE INDICATOR...
C
  555	CALL IFAXIS_YLABEL(TXT,YLN,NDG,IEX,NMAX)
     	RETURN
    	END

     	SUBROUTINE IFAXIS_Y2( XLN, YLN, TXT, FST, DEL,
     +                        DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS A LOG10 Y-AXIS AT THE CURRENT GRAPH ORIGIN
C
C	XLN --- X-AXIS LENGTH IN CURRENT UNITS.
C	YLN --- Y-AXIS LENGTH IN CURRENT UNITS.
C		IF YLN<0.0, AXIS ANNOTATION IS TO THE RIGHT OF AXIS.
C	TXT --- AXIS TITLE IN CHARACTER FORMAT.
C		IF TXT(1)="!", TITLE IS NOT CENTERED ON AXIS (LITERAL).
C		IF TXT(1)="^", TITLE IS PLACED ON TOP OF AXIS (HORIZONTAL).
C	FST --- SCALE VALUE AT THE FIRST MAJOR TICKMARK.
C 	DEL --- LOG CYCLES ON THE AXIS = MAJOR TICKMARK - 1.
C	DST --- DISTANCE OF FIRST TICKMARK AWAY FROM ORIGIN.
C 	NTK --- NUMBER OF DIVISIONS ON THE AXIS.
C 	MTK --- NUMBER OF MINOR TICKMARKS ON THE AXIS (NOT USED).
C		IF MTK<0, TICKMARKS TO THE SAME SIDE OF ANNOTATIONS.
C	NDG --- NUMBER OF SIGNIFICANT DIGITS FOR SCALE NUMBERS.
C		9=SKIP DRAWING THE SCALE NUMBERS.
C	IGD --- AXIS PATTERN CODE:
C		1: DRAW THE AXIS WITH MAJOR AND MINOR SCALE NUMBERS.
C		2: DRAW THE AXIS WITH MAJOR SCALE NUMBERS ONLY.
C		3: DRAW THE AXIS WITH GRID LINES ON MAJOR TICKS.
C		4: DRAW THE AXIS WITH GRID LINES ON MINOR TICKS AS WELL.
C	 DUAL IGD: DRAW THE OPPOSITE AXIS OF THE SAME PATTERN.
C	
     	INCLUDE 	'TEKLIB.CBS'
    	CHARACTER	TXT*(*)
     	DIMENSION	BLOG(9)
     	LOGICAL		PAIR, VT100
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C ) RETURN
    	YLEN = ABS(YLN)
    	IGRD = IABS(IGD)
    	PAIR = .FALSE.
     	VT100= .FALSE.
    	IF( IGRD.GT.10 ) THEN
    	    IGRD = MOD( IGRD, 10 )
    	    IF( IGRD.LT.1 ) IGRD = 1
    	    PAIR = .TRUE.
    	ENDIF
    	FIRST = LOG10(FST)
    	DELL  = DEL
    	DIST  = DST
    	IF( DELL.LT.0.0 ) FIRST = FIRST + DELL
    	NTIC = ABS(DELL) + 1.0
C
C  STORE LOG10S OF INTEGERS 1-9...
C
    	DO I=1, 9
    	   BLOG(I) = LOG10(FLOAT(I))
    	ENDDO
C
C  DETERMINE THE DELTA VALUE OF LOG10 CYCLES PER INCH...
C
    	DELTA = DELL / (YLEN-2.0*DIST)
    	DELL  = ABS(DELTA)
C
C  IF CYCLE LENGTH < 0.5 INCH, REDUCE THE NUMBER OF MAJOR TICKS...
C
    	IC = INT( 0.5*DELL ) + 1
C
C  PUT ON THE SCALING NUMBERS...
C
    	IF( IGRD.EQ.2 ) THEN
    	    ITC = 1
    	ELSE
    	    IF( DELL.LE.0.35 ) ITC = 9
    	    IF( DELL.GT.0.35 ) ITC = 9-INT((DELL-0.35)/0.1)
    	    IF( ITC.LT.1 ) ITC = 1
    	ENDIF
    	YB   = -0.005
    	YE   = YLEN+0.005
    	YN   = DIST
     	IF( DELTA.LT.0.0 ) YN = YLEN-DIST
    	IF( IGRD.NE.2 .AND. DIST.GT.0.1 ) THEN
    	    NTIC = NTIC + 2
    	    FIRST= FIRST - 1.0
    	    YN   = YN - 1.0/DELTA
    	ENDIF
    	NMAX = 0
    	IF( IABS(NDG).EQ.9 ) GOTO 222
     	SIZE = 0.1
     	SEXT = 0.06
     	IF( YLN.LT.0.0 ) THEN
     	    XM = 0.1
     	ELSE
     	    XM = -0.15
     	ENDIF
     	VT100 = ANSI
     	ANSI  = .FALSE.
    	DO MJ = 1, NTIC, IC
     	IF( CTRL_C ) RETURN
    	    FMJ = MJ - 1
    	    EX  = FIRST + FMJ
    	    NDGT= 1
    	    IF( EX.NE.0.0 ) NDGT = INT(LOG10(ABS(EX))) + 1
    	    IF( EX.LT.0.0 ) NDGT = NDGT + 1
     	    IF( NMAX.LT.NDGT ) NMAX = NDGT
    	    IF( YLN.LT.0.0 ) THEN
     		XAD = 0.125
     	    ELSE
    		XAD = -(0.3+0.07*NDGT)
     	    ENDIF
     	    DO  MI = 1, ITC
     		YAD = YN + (BLOG(MI)+FMJ)/DELTA
     		IF( YAD.GT.YB .AND. YAD.LT.YE ) THEN
     		    YAD = YAD - 0.05
     		    IF( MI.EQ.1 ) THEN
     		CALL IFTEXT( XAD, YAD, '10', SIZE, SIZE, 0.0 )
     		CALL IFTEXT_FPN(XAD+2*SIZE,YAD+0.8*SIZE,SEXT,EX,0.0,-1)
     			IF( VT100 ) CALL IFAXIS_LOG10( XAD, YAD, EX )
     		    ELSE
     		CALL IFTEXT_FPN(XM,YAD+0.02,SEXT,FLOAT(MI),0.0,-1)
     		    ENDIF
     		ENDIF
     	    ENDDO
     	ENDDO
     	ANSI = VT100
     	VT100= .FALSE.
C
C  DRAW THE TICKMARKS...
C
  222	ITC = 9
    	IF( IC.GT.1 ) ITC = 1
     	DYB = 0.08
     	IF( MTK.LT.0 ) DYB = -0.08
     	IF( YLN.LT.0.0 ) DYB = -DYB
     	DYC = 0.65*DYB
     	IF( IGRD.GT.2 ) DYB = XLN
     	IF( IGRD.EQ.4 ) DYC = XLN
     	XM = 0.0
     	IF( IGRD.EQ.4 ) CALL IFSTYL(2,0)
     	IF( ANSI ) CALL IFAXIS_ANSI( 0.0, 0.0, 0.0, YLEN )
  333	DO MJ = 1, NTIC
     	IF( CTRL_C ) RETURN
    	    FMJ = MJ - 1
    	    DO  MI = 1, ITC
     		YAD = YN + (BLOG(MI)+FMJ)/DELTA
     		IF( YAD.GT.YB .AND. YAD.LT.YE ) THEN
     		IF( MI.EQ.1 ) THEN
     		    IF( IGRD.EQ.3 ) CALL IFSTYL(2,0)
     		    CALL IFPLOT(XM,YAD,3)
     		IF( ANSI.AND..NOT.VT100 ) CALL IFANSI_DRAW(11)
     		    CALL IFPLOT(DYB,YAD,2)
     		    IF( IGRD.EQ.3 ) CALL IFSTYL(1,0)
     		ELSE IF( DELL.LT.2.0 ) THEN
     		    CALL IFPLOT(XM,YAD,3)
     		    CALL IFPLOT(DYC,YAD,2)
     		ENDIF
     		ENDIF
     	    ENDDO
     	ENDDO
  444	IF( IGRD.EQ.4 ) CALL IFSTYL(1,0)
     	IF(IGD.LT.0.AND.DELTA.GT.0.0) CALL IFARRH( 1, XM,
     +  YLEN+0.25, 0.25, 0.04, 0.15, 90.0 )
    	CALL IFPLOT (XM,YLEN,3)
    	CALL IFPLOT (XM,0.0,2)
    	IF( .NOT.PAIR ) GOTO 555
C
C  DRAW THE OPPOSITE AXIS...
C
     	XM = XLN
     	PAIR = .FALSE.
     	VT100= .TRUE.
    	IF( IGRD.EQ.4 ) GOTO 444
     	IF( IGRD.EQ.3 ) DYB = 0.0
     	DYB = XLN - DYB
     	DYC = XLN - DYC
     	GOTO 333
C
C  DRAW THE AXIS TITLE IF ANY...
C
  555	CALL IFAXIS_YLABEL(TXT,YLN,NDG,0,2+NMAX/2)
     	RETURN
    	END

     	SUBROUTINE IFAXIS_Y3( XLN, YLN, TXT, FST, DEL,
     +                        DST, NTK, MTK, NDG, IGD )
C
C  PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS AN INVERSE-LINEAR Y-AXIS AT ACTIVE GRAPH ORIGIN.
C
C	XLN --- X-AXIS LENGTH IN INCHES.
C	YLN --- Y-AXIS LENGTH IN INCHES.
C		IF YLN<0.0, AXIS ANNOTATION IS TO THE RIGHT OF AXIS.
C	TXT --- AXIS TITLE IN CHARACTER FORMAT.
C		IF TXT(1)="!", TITLE IS NOT CENTERED ON AXIS.
C		IF TXT(1)="^", TITLE IS PLACED ON TOP OF AXIS.
C	FST --- SCALE VALUE AT THE FIRST MAJOR TICKMARK.
C	DEL --- CHANGE IN SCALE UNITS BETWEEN MAJOR TICKMARKS.
C	DST --- DISTANCE OF FIRST TICKMARK AWAY FROM ORIGIN.
C 	NTK --- NUMBER OF DIVISIONS ON THE AXIS.
C 	MTK --- NUMBER OF MINOR TICKMARKS ON THE AXIS.
C		IF MTK<0, TICKMARKS TO THE SAME SIDE OF ANNOTATIONS.
C	NDG --- NUMBER OF SIGNIFICANT DIGITS FOR SCALE NUMBERS.
C		0 = ROUTINE DETERMINED, 9=NO ANNOTATION.
C		0<= SKIP DRAWING THE MULTIPLIER.
C	IGD --- AXIS PATTERN CODE:
C		1: DRAW THE AXIS WITH MAJOR AND MINOR TICKS.
C		2: DRAW THE AXIS WITH MAJOR TICK ONLY.
C		3: DRAW THE AXIS WITH GRID LINES ON MAJOR TICKS.
C		4: DRAW THE AXIS WITH GRID LINES ON MINOR TICKS AS WELL.
C	MINUS IGD: DRAW THE AXIS WITH ARROWHEAD.
C	 DUAL IGD: DRAW THE OPPOSITE AXIS OF THE SAME PATTERN.
C	
     	INCLUDE		'TEKLIB.CBS'
    	CHARACTER	TXT*(*)
     	LOGICAL		PAIR, VT100
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C ) RETURN
    	YLEN = ABS(YLN)
    	IGRD = IABS(IGD)
    	PAIR = .FALSE.
     	VT100= .FALSE.
    	IF( IGRD.GT.10 ) THEN
    	    IGRD = MOD( IGRD, 10 )
    	    IF( IGRD.LT.1 ) IGRD = 1
    	    PAIR = .TRUE.
    	ENDIF
    	FIRST= FST
    	DELL = DEL
    	DIST = DST
    	NTIK = IABS(NTK)+1
    	MTIK = IABS(MTK)
C
C  DETERMINE THE LENGTH OF SCALING NUMBERS...
C
    	IEX  = 0
     	CALL IFAXIS_DIGITS( NDG, NTIK, FIRST, DELL,
     +                      NDIGIT, IEX, YVL, ADY )
    	NMAX = 0
     	YAD  = YVL + (NTIK-1)*ADY
    	YAD  = (1.0/YAD-1.0/YVL)/(YLEN-2.0*DIST)
    	IF( IABS(NDG).EQ.9 ) GOTO 222
C
C  PUT ON THE SCALE NUMBERS...
C
     	SIZE= 0.1
    	YDA = 1.0/YVL
     	YN  = DIST - 0.5*SIZE
    	YVV = YVL
    	XM  = 0.125
    	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
C
C  DETERMINE THE LENGTH OF YVV...
C
    	   IF( ABS(YVV).GE.1.0 ) THEN
    	       NDT = LOG10(ABS(YVV))
    	       NDT = NDT + 1
    	   ELSE
    	       NDT = 1
    	   ENDIF
    	   IF( NDIGIT.GT.0 ) NDT = NDT + NDIGIT + 1
    	   IF( YVV.LT.0.0 ) NDT = NDT + 1
    	   IF( NDT.GT.NMAX ) NMAX = NDT
    	   IF( YLN.GT.0.0 ) XM = -SIZE*(NDT+1)
    	   YYD = YN + (1.0/YVV-YDA)/YAD
     	   IF( DIST.EQ.0.0 ) THEN
     		IF( I.EQ.NTIK ) YYD = YYD - 0.05
     		IF( I.EQ. 1   ) YYD = YYD + 0.05
     	   ENDIF
     	   CALL IFTEXT_FPN( XM, YYD, SIZE, YVV, 0.0, NDIGIT )
    	   YVV = YVV + ADY
    	ENDDO
C
C  DRAW THE TICK MARKS OR GRID LINES...
C
  222	IF( IGRD.LT.4 ) THEN
     	    DYB = 0.08
    	    IF( MTK.LT.0 ) DYB = -0.08
    	    IF( YLN.LT.0.0 ) DYB = -DYB
     	    IF( IGRD.EQ.2 ) THEN
     		MTIK = 0
     	    ELSE
     		DYC = 0.65*DYB
     	    ENDIF
     	ENDIF
     	IF( IGRD.GT.2 ) THEN
     	    DYB = XLN
    	    IF( IGRD.EQ.4 ) DYC = XLN
    	ENDIF
     	YDA = ADY
    	IF( MTIK.GT.0 ) YDA = ADY / (MTIK+1)
     	YN = DIST
     	YB = -0.005
     	YE = YLEN+0.005
     	XM = 0.0
     	IF( IGRD.EQ.4 ) CALL IFSTYL(2,0)
     	IF( ANSI ) CALL IFAXIS_ANSI( 0.0, 0.0, 0.0, YLEN )
333	YVV = YVL
    	YV1 = 1.0/YVL
     	ADY = YN
    	DO I=1, NTIK
     	IF( CTRL_C ) RETURN
     	    IF( ADY.GT.YE ) GOTO 444
    	    IF( ADY.GT.YB ) THEN
     		IF( IGRD.EQ.3 ) CALL IFSTYL(2,0)
     		CALL IFPLOT (XM,ADY,3)
     		IF( ANSI.AND..NOT.VT100 ) CALL IFANSI_DRAW(11)
     		CALL IFPLOT (DYB,ADY,2)
     		IF( IGRD.EQ.3 ) CALL IFSTYL(1,0)
     	    ENDIF
     	    DO  K=1, MTIK
     		YVV = YVV + YDA
     		ADY = YN + (1.0/YVV-YV1)/YAD
     		IF( ADY.GT.YE ) GOTO 444
     		IF( ADY.GT.YB ) THEN
     		    CALL IFPLOT (XM,ADY,3)
     		    CALL IFPLOT (DYC,ADY,2)
     		ENDIF
     	    ENDDO
     	    YVV = YVV + YDA
     	    ADY = YN + (1.0/YVV-YV1)/YAD
     	ENDDO
444	IF( IGRD.EQ.4 ) CALL IFSTYL(1,0)
     	CALL IFPLOT (XM,0.0,3)
    	CALL IFPLOT (XM,YLEN,2)
     	IF(IGD.LT.0.AND.DELL.GT.0.0) CALL IFARRH( 1, XM,
     +  YLEN+0.25, 0.25, 0.04, 0.15, 90.0 )
    	IF( .NOT.PAIR ) GOTO 555
C
C  DRAW THE OPPOSITE AXIS...
C
     	XM = XLN
     	PAIR = .FALSE.
     	VT100= .TRUE.
    	IF( IGRD.EQ.4 ) GOTO 444
     	IF( IGRD.EQ.3 ) DYB = 0.0
     	DYB = XLN-DYB
     	DYC = XLN-DYC
     	GOTO 333
C
C  DRAW THE TITLE AND MAGNITUDE INDICATOR...
C
  555	CALL IFAXIS_YLABEL(TXT,YLN,NDG,IEX,NMAX)
     	RETURN
    	END

    	FUNCTION IFAXIS_LINSCL( FLEN, AMIN, AMAX )
C
C	THIS ROUTINE DOES AUTOMATIC SCALING OF AXIS UNITS.
C
C	FLEN ----- INPUT AXIS LENGTH IN INCHES.
C	AMIN ----- MINIMUM VALUE OF DATA SET.
C		   RETURN AS "ROUNDOFF" MINIMUM VALUE.
C	AMAX ----- MAXIMUM VALUE OF DATA SET.
C		   RETURN AS "ROUNDOFF" MAXIMUM VALUE.
C
C	IFAXIS_LINSCL = NUMBER OF DIVISION ON THE AXIS.
C
     	FMIN = AMIN
     	FMAX = AMAX
     	STEP = 1.25*(FMAX-FMIN)/FLEN
     	IF( STEP.GT.1.0 ) THEN
     	    EXT = 10.0**INT(LOG10(STEP))
     	ELSE
     	    EXT = 10.0**INT(LOG10(STEP)-1.0)
     	ENDIF
     	STEP = EXT*FLOAT(INT(STEP/EXT+0.5))
     	RMIN = STEP*INT(FMIN/STEP)
     	IF( RMIN.GT.FMIN ) RMIN = RMIN - STEP
     	RMAX = STEP*INT(FMAX/STEP)
     	IF( RMAX.LT.FMAX ) RMAX = RMAX + STEP

     	AMIN = RMIN
     	AMAX = RMAX
     	IFAXIS_LINSCL = (RMAX-RMIN)/STEP + 0.1

     	RETURN
     	END

    	FUNCTION IFAXIS_LOGSCL( AMIN, AMAX )
C
C	AMIN ---- INPUT MINIMUM AND RETURN ROUNDOFF MINIMUM
C	AMAX ---- INPUT MAXIMUM AND RETURN ROUNDOFF MAXIMUM
C
C	IFAXIS_LOGSCL = LOG10 CYCLES ON THE AXIS.
C
    	FLO1 = LOG10(AMIN)
    	FLO2 = INT( FLO1 )
    	IF( FLO1.LT.0.0 .AND. FLO1.LT.(FLO2-0.01) ) FLO2=FLO2-1.0
    	AMIN = 10.0**FLO2

    	FHI1 = LOG10(AMAX)
    	FHI2 = INT( FHI1 )
    	IF( FHI1.GT.(FHI2+0.01) ) FHI2 = FHI2 + 1.0
    	AMAX = 10.0**FHI2

     	IFAXIS_LOGSCL = FHI2-FLO2+0.1
     	RETURN
    	END

     	SUBROUTINE IFAXIS_DIGITS( NNN, NTIK, FIRST, DELL,
     +                            NDIGIT, IEX, XVL, ADX )
C
C  DETERMINE THE LENGTH OF SCALING NUMBERS...
C
     	NDGS  = IABS(NNN)
    	FMAX1 = ABS(FIRST)
    	FMAX2 = ABS( FIRST + DELL*(NTIK-1) )
    	FMAX  = MAX( FMAX1, FMAX2 )
    	ADX   = LOG10( FMAX )
    	IADX  = ADX

    	IF( NDGS.EQ.0 ) THEN
C
C  AUTO SCALING; MAX DIGITS <= 8...
C
    	    IF( IADX.GT.4 ) IEX = IADX
    	    IF( ADX.LT.-1.) THEN
    		IEX = IADX
    		IF( ADX.NE.FLOAT(IADX) ) IEX = IEX - 1
    	    ENDIF
    	ELSE
C
C  USER SPECIFIES THE DIGITS...
C
    	    IF( ADX.GE.0.0 ) THEN
    		IF( NDGS.LT.(IADX+1) ) THEN
    		    IEX = IADX
    		    NDIGIT = NDGS - 1
    		ENDIF
    		IF( NDGS.EQ.(IADX+1) ) NDIGIT = -1
    		IF( NDGS.GT.(IADX+1) ) NDIGIT = NDGS - (IADX+1)
    	    ELSE
    	        IF( ADX.LT.-NDGS ) THEN
    		    IEX = IADX
    		    IF( ADX.NE.FLOAT(IADX) ) IEX = IEX - 1
    		    NDIGIT = NDGS - 1
    		ELSE
    		    NDIGIT = NDGS
    		ENDIF
    	    ENDIF
    	ENDIF

    	XVL = FIRST*10.0**(-IEX)
    	ADX = DELL*10.0**(-IEX)
    	IF( NDGS.GT.0 ) RETURN
C
C  DETERMINE THE LENGTH OF DECIMAL DIGITS...
C
    	MDGS = -2
    	DIGIT = ABS(ADX)
    	DO I=1,2
    	   DIGIT = ABS(AINT((DIGIT-AINT(DIGIT))*1000.0+.5))
    	   IF( DIGIT.GT.0.0 ) NDIGIT = 3
    	   IF( DIGIT.EQ.AINT(DIGIT/10.)*10. ) NDIGIT = 2
    	   IF( DIGIT.EQ.AINT(DIGIT/100.)*100. ) NDIGIT = 1
    	   IF( DIGIT.EQ.0.0 ) NDIGIT = -1
    	   IF( NDIGIT.GT.MDGS ) MDGS = NDIGIT
    	   DIGIT = ABS(XVL)
    	ENDDO
    	NDIGIT = MDGS
     	RETURN
     	END

     	SUBROUTINE IFAXIS_XLABEL(TXT,XLN,NDG,IEX)
    	CHARACTER EXT*7, TXT*(*)

     	YAD = -0.6
    	IF( XLN.LT.0.0 ) YAD = 0.48
    	IF( IABS(NDG).EQ.9 ) YAD = 0.8*YAD
     	ICH = 1					!CENTERED TITLE
     	NCH = IFMISC_LENG( TXT )
     	IF( NCH.GT.0 ) THEN
     	    IF( TXT(1:1).EQ.'!' ) ICH = 2	!LITERAL TITLE
    	    NCH = IFTEXT_STRIP( TXT(ICH:) )
     	ENDIF
     	SIZE = 0.12
    	NEX = NCH
    	IF( IABS(NDG).NE.9.AND.NDG.GE.0.AND.IEX.NE.0 ) NEX = NEX+7
    	IF( NCH.GT.0 ) THEN
     	    IF( ICH.EQ.2 ) XAD = 0.0
    	    IF( ICH.EQ.1 ) XAD = 0.5*(ABS(XLN)-SIZE*NEX)
    	    CALL IFTEXT_EXT( XAD, YAD, TXT(ICH:), SIZE, SIZE, 0.0 )
    	    XAD = XAD + (NCH+1)*SIZE
    	ELSE
    	    XAD = 0.5*(ABS(XLN)-SIZE*(NEX-2))
    	ENDIF
    	IF( IEX.EQ.0.OR.IABS(NDG).EQ.9.OR.NDG.LT.0 ) GOTO 999
    	IF( IEX.EQ.1 ) THEN
    	    EXT = '(x10)'
    	ELSE
    	    EXT = '(x10 )'
    	    IF( IABS(IEX).GT.9 .OR. IEX.LT.0 ) EXT = '(x10  )'
    	ENDIF
    	CALL IFTEXT( XAD, YAD, EXT, SIZE, SIZE, 0.0 )
    	IF( IEX.NE.1 ) CALL IFTEXT_FPN( XAD+4*SIZE,
     +                 YAD+.8*SIZE, 0.06, FLOAT(IEX), 0.0, -1 )
999	RETURN
     	END

     	SUBROUTINE IFAXIS_YLABEL(TXT,YLN,NDG,IEX,MAX)
     	CHARACTER EXT*7, TXT*(*)

     	ICH = 1				!CENTERED TITLE
     	NCH = IFMISC_LENG(TXT)
     	IF( NCH.GT.0 ) THEN
     	    IF(TXT(1:1).EQ.'!'.OR.TXT(1:1).EQ.'^') ICH=2 !LITERAL TITLE
    	    NCH = IFTEXT_STRIP( TXT(ICH:) )
     	ENDIF
    	IK = NCH
    	IF( IABS(NDG).NE.9.AND.NDG.GE.0.AND.IEX.NE.0 ) IK= IK+7
C
C  GET THE X-COORDINATE FOR PLACING THE TITLE...
C
     	SIZE = 0.1
	IFLG = 0
	IF( TXT(1:1).EQ.'^' ) THEN
	    IFLG = 1				!HORIZONTAL LABELING ON
	    XM = -0.5*SIZE*IK
	    IF( XM.LT.-1.5 ) THEN
     		XM = -1.5			!MAX 1.5 INCH OFFSET
     		IF( YLN.LT.0.0 ) XM = 2.0*XM+1.5
     	    ENDIF
	ELSE
	    IF( IABS(NDG).EQ.9 ) THEN
    	    	XM = -0.35
    	    	IF( YLN.LT.0.0 ) XM = 0.47
    	    ELSE
    	    	XM = -SIZE*MAX - 0.25
    	    	IF( YLN.LT.0.0 ) XM = SIZE*MAX+0.37
    	    ENDIF
	ENDIF
C
C  GET THE Y-COORDINATE FOR PLACING THE TITLE...
C
     	SIZE = 0.12
     	YLEN = ABS(YLN)
    	IF( NCH.GT.0 ) THEN
	    IF( IFLG.EQ.0 ) THEN
    	    	IF( ICH.EQ.1 ) THEN
     		    CALL IFSCAL_NOW( XN, YN )
     		    YT = 0.5*(YLEN-SIZE*IK*XN/YN)
     	    	ENDIF
     	    	IF( ICH.EQ.2 ) YT = 0.0
    	        CALL IFTEXT_EXT(XM,YT,TXT(ICH:),SIZE,SIZE,90.)
    	    	YT = YT + (NCH+1)*SIZE
	    ELSE
		YT = YLEN + 0.15
    	    	CALL IFTEXT_EXT(XM,YT,TXT(ICH:),SIZE,SIZE,0.0)
		XM = XM + (NCH+1)*SIZE
	    ENDIF
    	ELSE
    	    IF( IFLG.EQ.0 ) THEN
     		CALL IFSCAL_NOW( XN, YN )
		YT = 0.5*(YLEN-SIZE*(IK-2)*XN/YN)
    	    ELSE
		YT = YLEN + 0.15
		XM = -0.5*SIZE*(IK-2)
	    ENDIF
    	ENDIF
    	IF( IEX.EQ.0.OR.IABS(NDG).EQ.9.OR.NDG.LT.0 )  GOTO 999
    	IF( IEX.EQ.1 ) THEN
    	    EXT = '(x10)'
    	ELSE
    	    EXT = '(x10 )'
    	    IF( IABS(IEX).GT.9 .OR. IEX.LT.0 ) EXT = '(x10  )'
    	ENDIF
	IF( IFLG.EQ.0 ) THEN
     	    CALL IFTEXT( XM, YT, EXT, SIZE, SIZE, 90.0 )
    	    IF( IEX.NE.1 ) CALL IFTEXT_FPN( XM-.8*SIZE,
     +                     YT+4*SIZE, 0.06, FLOAT(IEX), 90., -1 )
	ELSE
     	    CALL IFTEXT( XM, YT, EXT, SIZE, SIZE, 0.0 )
    	    IF( IEX.NE.1 ) CALL IFTEXT_FPN( XM+4*SIZE,
     +                     YT+.8*SIZE, 0.06, FLOAT(IEX), 0.0, -1 )
	ENDIF
999	RETURN
     	END

     	SUBROUTINE IFAXIS_ANSI( X1, Y1, X2, Y2 )
C
C	THIS ROUTINE DRAWS AN AXIS LINE SEGMENT ON VT100.
C
     	CALL IFINIT_DIF(0)
     	CALL IFPLOT_VECT( X1, Y1, 3 )
     	CALL IFANSI_LAST( IL1, IC1 )
     	CALL IFPLOT_VECT( X2, Y2, 3 )
     	CALL IFANSI_LAST( IL2, IC2 )
     	CALL IFANSI_LINE( IL1, IC1, IL2, IC2 )
     	CALL IFINIT_DIF(1)
     	RETURN
     	END

     	SUBROUTINE IFAXIS_LOG10( XPS, YPS, EX )
     	CHARACTER EXT*3
     	WRITE(EXT,111) INT(EX)
  111	FORMAT(I3)
C     	ENCODE( 3, 111, EXT ) INT(EX)
     	NCH = IFMISC_STRIP(EXT)
     	CALL IFANSI_CHAR( XPS+0.1*(3-NCH), YPS, NCH, EXT )
     	RETURN
     	END

    	SUBROUTINE IFBARS( XOP, YOP, BARL, BARH, BARW, ANGLE )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE DRAWS A BAR/BOX.
C
C	XOP ------- CENTER OF BAR IN INCHES (X).
C	YOP ------- CENTER OF BAR IN INCHES (Y).
C	BARL ------ BAR LENGTH IN INCHES IN X-AXIS.
C	BARH ------ BAR HEIGHT IN INCHES IN Y-AXIS.
C	BARW ------ BAR BORDER WIDTH IN INCHES.
C	ANGLE ----- ROTATION ANGLE OF BAR IN DEGREES.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( ABS(BARL).LT.0.02 .OR. ABS(BARH).LT.0.02 ) RETURN
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
C
C  INITIALIZE...
C
     	IDW = 0
     	XPS = XOP
     	YPS = YOP
     	RD1 = 0.5*ABS(BARL)
     	RD2 = 0.5*ABS(BARH)
     	WID = ABS(BARW)
     	IF( WID.GE.RD1 .OR. WID.GE.RD2 ) WID = 0.0
     	ANG = AMOD( ANGLE, 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	CALL IFPLOT( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( ANG.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANG+XANG, ANG+YANG )
     	ENDIF
C
C  START THE DRAWING...
C
111	CALL IFPLOT( -RD1, -RD2, 3 )
     	CALL IFPLOT( -RD1,  RD2, 2 )
     	CALL IFPLOT(  RD1,  RD2, 2 )
     	CALL IFPLOT(  RD1, -RD2, 2 )
     	CALL IFPLOT( -RD1, -RD2, 2 )
     	IF( WID.EQ.0.0 ) GOTO 222
     	RD1 = RD1 - WID
     	RD2 = RD2 - WID
     	WID = 0.0
     	GOTO 111
C
C  RESTORE...
C
222	IF( ANG.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XOP, -YOP, -9 )

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) BARL,BARH,BARW, XOP,YOP,ANGLE
     	ENDIF
1000	FORMAT('BARS:',6F8.3)

     	IDW = IWD

999	RETURN
    	END
    	SUBROUTINE IFBOXS( XOP, YOP, BARL, BARH, BARW, ANGLE )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE DRAWS A BAR/BOX WITH ROUND CORNERS.
C
C	XOP ------- CENTER OF BAR IN INCHES (X).
C	YOP ------- CENTER OF BAR IN INCHES (Y).
C	BARL ------ BAR LENGTH IN INCHES IN X-AXIS.
C	BARH ------ BAR HEIGHT IN INCHES IN Y-AXIS.
C	BARW ------ BAR BORDER WIDTH IN INCHES.
C	ANGLE ----- ROTATION ANGLE OF BAR IN DEGREES.
C
     	INCLUDE 'TEKLIB.CBS'

     	IWD = IDW
     	IF( ABS(BARL).LT.0.05 .OR. ABS(BARH).LT.0.05 ) RETURN
     	IF( ITM.EQ.1 ) GOTO 888
C
C  INITIALIZE...
C
     	IDW = 0
     	XPS = XOP
     	YPS = YOP
     	RD1 = 0.5*ABS(BARL)
     	RD2 = 0.5*ABS(BARH)
     	WID = ABS(BARW)
     	IF( WID.GE.RD1 .OR. WID.GE.RD2 ) WID = 0.0
     	ANG = AMOD( ANGLE, 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	CALL IFPLOT( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( ANG.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANG+XANG, ANG+YANG )
     	ENDIF
C
C  GET THE CORNER RADIUS...
C
111	IF( RD1.LT.RD2 ) THEN
     	    CRAD = 0.4*RD1
     	    IF( CRAD.LT..05 ) CRAD = .05
     	    IF( CRAD.GT.RD1 ) CRAD = RD1
     	ELSE
     	    CRAD = 0.4*RD2
     	    IF( CRAD.LT..05 ) CRAD = .05
     	    IF( CRAD.GT.RD2 ) CRAD = RD2
     	ENDIF
C
C  START THE DRAWING...
C
     	CALL IFPLOT( RD1,  0.0, 3 )
     	IF( CRAD.LT.RD2 ) CALL IFPLOT( RD1, RD2-CRAD, 2 )
     	CALL IFBOXS_ARC( RD1-CRAD, RD2-CRAD, CRAD, 0.0  )
     	IF( CRAD.LT.RD1 ) CALL IFPLOT( CRAD-RD1, RD2, 2 )
     	CALL IFBOXS_ARC( CRAD-RD1, RD2-CRAD, CRAD, 90.0 )
     	IF( CRAD.LT.RD2 ) CALL IFPLOT( -RD1, CRAD-RD2, 2 )
     	CALL IFBOXS_ARC( CRAD-RD1, CRAD-RD2, CRAD, 180.0 )
     	IF( CRAD.LT.RD1 ) CALL IFPLOT( RD1-CRAD, -RD2, 2 )
     	CALL IFBOXS_ARC( RD1-CRAD, CRAD-RD2, CRAD, 270.0 )
     	IF( CRAD.LT.RD2 ) CALL IFPLOT( RD1, 0.0, 2 )

     	IF( WID.EQ.0.0 ) GOTO 222
     	RD1 = RD1 - WID
     	RD2 = RD2 - WID
     	WID = 0.0
     	GOTO 111
C
C  RESTORE...
C
222	IF( ANG.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XOP, -YOP, -9 )

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) BARL,BARH,BARW, XOP,YOP,ANGLE
     	ENDIF
1000	FORMAT('BOXS:',6F8.3)

     	IDW = IWD

999	RETURN
    	END

     	SUBROUTINE IFBOXS_ARC( XPS, YPS, RAD, ANS )
C
C	THIS ROUTINE DRAWS AN ARC OF A BOX.
C
     	XPP = XPS
     	YPP = YPS
     	ANG = ANS
     	RDD = RAD
     	DO I=1, 9
     	   ANG = ANG + 10.0
     	   XOP = RDD*COSD(ANG) + XPP
     	   YOP = RDD*SIND(ANG) + YPP
     	   CALL IFPLOT( XOP, YOP, 2 )
     	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFCOPY( ARRAY, PLOTID )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE SETS UP HARDCOPY PLOT PAGES.
C
C	"ARRAY" SHOULD BE DIMENSIONED TO 20:
C
C	ARRAY(1): HARDCOPY DEVICE NUMBER.
C	ARRAY(2): NUMBER OF HARDCOPIES.
C	ARRAY(3): PLOT ID FLAG.
C	ARRAY(4): PAGE FEED FLAG.
C	ARRAY(5): HARDCOPY SETUP PARAMETER 1 (OFFSET X).
C	ARRAY(6): HARDCOPY SETUP PARAMETER 2 (OFFSET Y).
C	ARRAY(7): HARDCOPY SETUP PARAMETER 3 (SCALE  X).
C	ARRAY(8): HARDCOPY SETUP PARAMETER 4 (SCALE  Y).
C	........  ........
C	ARRAY(20): HARDCOPY SETUP PARAMETER 20.
C
C	PLOTID: PLOT ID LABEL
C
     	INCLUDE     'TEKLIB.CBS'
     	CHARACTER    TEXT*64, KEY*2, OUTPUT*32, IDPLOT*32, PLOTID*(*)
    	DIMENSION    RP(2), KP(2), ARRAY(1)
     	COMMON/IFCOPY/ SETUP(20), OUTPUT, IDPLOT
     	EQUIVALENCE (KEY,TEXT(1:2))
     	DATA SETUP/ 1.,1.,1.,1.,0,0,1.,1.,1.,0,5.,1.,1.,0,0,0,0,0,0,0 /
     	DATA OUTPUT/ ' ' /
C
C  IF META-FILE NOT PRESENT, RETURN...
C
     	IF( IDF.EQ.0 ) THEN
     	    CALL IFMISC_OOPS( 12, 0, 0, ' ' )
     	    RETURN
     	ENDIF
C
C  INITIALIZE THE PAGE SETUP...
C
     	IDPLOT = PLOTID
     	IF( IDPLOT.EQ.' ' ) THEN
     	    IDPLOT = DTNAME
     	    NCHS = INDEX( IDPLOT, ']' )
     	    IF( NCHS.GT.0 ) IDPLOT = IDPLOT(NCHS+1:)
     	ENDIF
     	IF( IF_DCL_HARDCOPY() ) THEN
     	    CALL IFFEED( ARRAY(1), IDPLOT, OUTPUT )
     	    RETURN
     	ENDIF
     	IF( ARRAY(1).NE.0.0 ) THEN
     	    DO  I=1, 20
     		SETUP(I) = ARRAY(I)
     	    ENDDO
     	ENDIF
     	I  = IFMISC_STRIP(OUTPUT)
     	CALL IFMISC_UPPER(I,OUTPUT)
C
C  LAYOUT DIALOGUE MENU...
C
     	CALL IFMAC_KEYEXP(0)
     	CALL IFCOPY_MENU
     	CALL IFCOPY_DATA(0)
C
C  START THE DIALOGUE LOOP...
C
111	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_TEXT('HARDCOPY> ',10,21,1)
    	CALL IFANSI_CLEAR(4)
     	I = IFQIOW( NCHS, TEXT )
     	IF( I.EQ.26 ) GOTO 888
     	IF( NCHS.EQ.0 ) GOTO 111
     	NCHS = IFMISC_STRIP( TEXT )
     	CALL IFMISC_UPPER( 4, TEXT )
     	IF( KEY.EQ.'EX' .OR. KEY.EQ.'QU' .OR.
     +      (I.EQ.27.AND.KEY.EQ.'OS') ) GOTO 888
     	IF( (NCHS.EQ.2 .AND.KEY.EQ.'GO') .OR.
     +      (I.EQ.27.AND.KEY.EQ.'OP') ) GOTO 999
C
C  REFRESH THE DIALOGUE MENU...
C
     	IF( TEXT(1:3).EQ.'REF' .OR.
     +      (I.EQ.27.AND.KEY.EQ.'OR') ) THEN
     	    CALL IFCOPY_MENU
      	    CALL IFCOPY_DATA(0)
            GOTO 111
      	ENDIF
        IF( I.EQ.27 ) CALL IFMISC_OOPS( 5, 20, 6, ' ' )
C
C  CLEAR THE "OOPS" LINE...
C
     	CALL IFANSI_CURSOR(20,6)
    	CALL IFANSI_CLEAR(4)
C
C  DISPLAY THE ON-LINE HELP...
C
     	IF( TEXT(1:4).EQ.'HELP' ) THEN
     	    IF( NCHS.LT.6 ) THEN
     		CALL IFMISC_OOPS( 4, 20, 6, ' ' )
     	    ELSE
     	        CALL IFMISC_UPPER( NCHS, TEXT )
     	        NCHS = INDEX( TEXT(6:), 'DV' )
     		IF( NCHS.GT.0 ) THEN
     		    CALL IFCOPY_HELP
     		    CALL IFCOPY_MENU
     		    CALL IFCOPY_DATA(0)
     		ELSE
     		    CALL IFMISC_HLP( 'HARDCOPY', TEXT, 20, 6 )
     		ENDIF
     	    ENDIF
     	    GOTO 111
	ENDIF
C
C  DECODE THE NEW PARAMETERS...
C
     	IF( NCHS.LT.3 .OR. TEXT(3:3).NE.'=' ) GOTO 777
     	IF( KEY.EQ.'ID' ) THEN
     	    IDPLOT = TEXT(4:)
     	    NCHS = 12
     	    GOTO 555
     	ENDIF
     	IF( KEY.EQ.'OD' ) THEN
     	    OUTPUT = TEXT(4:)
     	    NCHS = 13
     	    GOTO 555
     	ENDIF
     	NCHS = NCHS-3
     	IF( NCHS.GT.0 ) NCHS=IFMISC_DECODE(TEXT(4:),NCHS,2,RP,KP)
     	IF( NCHS.EQ.0 ) GOTO 777
C
C  STORE THE NEW PARAMETERS...
C
     	IF( KEY.EQ.'DV' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.1 .OR. NCHS.GT.99 ) GOTO 666
     	    SETUP(1) = NCHS
     	    NCHS = 1
     	ELSE IF( KEY.EQ.'NC' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.1 .OR. NCHS.GT.99 ) GOTO 666
     	    SETUP(2) = NCHS
     	    NCHS = 2
     	ELSE IF( KEY.EQ.'LB' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.0 .OR. NCHS.GT.1 ) GOTO 666
    	    SETUP(3) = NCHS
     	    NCHS = 3
     	ELSE IF( KEY.EQ.'PF' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.0 .OR. NCHS.GT.1 ) GOTO 666
    	    SETUP(4) = NCHS
     	    NCHS = 4
     	ELSE IF( KEY.EQ.'PO' ) THEN
     	    IF( KP(1).EQ.1 ) THEN
     		IF( ABS(RP(1)).GT.99.0 ) GOTO 666
     		SETUP(5) = RP(1)
     	    ENDIF
     	    IF( KP(2).EQ.1 ) THEN
     		IF( ABS(RP(2)).GT.99.0 ) GOTO 666
     		SETUP(6) = RP(2)
     	    ENDIF
     	    NCHS = 5
     	ELSE IF( KEY.EQ.'SF' ) THEN
     	    IF( KP(1).EQ.1 ) THEN
     		IF( RP(1).EQ.0.0 .OR. ABS(RP(1)).GT.9.0 ) GOTO 666
     		SETUP(7) = RP(1)
     	    ENDIF
     	    IF( KP(2).EQ.1 ) THEN
     		IF( RP(2).EQ.0.0 .OR. ABS(RP(2)).GT.9.0 ) GOTO 666
     		SETUP(8) = RP(2)
     	    ENDIF
     	    NCHS = 6
     	ELSE IF( KEY.EQ.'LW' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.1 .OR. NCHS.GT.9 ) GOTO 666
    	    SETUP(9) = NCHS
     	    NCHS = 7
     	ELSE IF( KEY.EQ.'VP' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.0 .OR. NCHS.GT.1 ) GOTO 666
    	    SETUP(10) = NCHS
     	    NCHS = 8
     	ELSE IF( KEY.EQ.'PS' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.1 .OR. NCHS.GT.9 ) GOTO 666
    	    SETUP(11) = NCHS
     	    NCHS = 9
     	ELSE IF( KEY.EQ.'FT' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.1 .OR. NCHS.GT.9 ) GOTO 666
    	    SETUP(12) = NCHS
     	    NCHS = 10
     	ELSE IF( KEY.EQ.'BC' ) THEN
     	    NCHS = RP(1)
     	    IF( NCHS.LT.1 .OR. NCHS.GT.9 ) GOTO 666
    	    SETUP(13) = NCHS
     	    NCHS = 11
     	ELSE
     	    GOTO 777
     	ENDIF
555	CALL IFCOPY_DATA(NCHS)
     	GOTO 111
666	CALL IFMISC_OOPS( 3, 20, 6, TEXT(4:) )
    	GOTO 111
777	CALL IFMISC_OOPS( 2, 20, 6, TEXT )
    	GOTO 111
888	NCHS = -1
C
C  DUMP THE HARDCOPY...
C
999	IF( NCHS.GE.0 ) CALL IFFEED(SETUP(1),IDPLOT,OUTPUT)
     	CALL IFMAC_KEYEXP(1)
     	DO I=1, 20
     	   ARRAY(I) = SETUP(I)
     	ENDDO
     	PLOTID = IDPLOT
     	RETURN
    	END

     	SUBROUTINE IFCOPY_MENU
C
C	THIS ROUTINE LAYOUTS DIALOGUE MENU FOR HARDCOPY PAGE SETUP.
C
        CHARACTER TEXT*80

     	CALL IFINIT_LINE(24)
    	CALL IFANSI_VIDEO(24)
    	CALL IFANSI_VIDEO(90)
     	TEXT(1:45) = '              M E N U   O F   H A R D C O P Y'
        TEXT(46: ) = '   P A G E   S E T U P'
     	CALL IFANSI_TEXT( TEXT, 80, 1, 1 )
    	CALL IFANSI_VIDEO(47)
	WRITE(6,1000)
1000	FORMAT(
     + 5x'NC= 0 .............'
     +,' Number of hardcopies to make ...... Maximum 99.'/
     +,5x'LB= 0 .............'
     +,' Plot ID labeling .................. 0=Off, 1=On.'/
     +,5x'PF= 0 .............'
     +,' Plot page feed upon finish ........ 0=Off, 1=On.'/
     +,5x'LW= 0 .............'
     +,' Plotting stylus/linewidth ......... Bold lines.'/
     +,5x'VP= 0 .............'
     +,' Vertical page alignment ........... 0=Off, 1=On.'/
     +,5x'PS= 0 .............'
     +,' Pen speed for a pen plotter ....... 1 to 9.'/
     +,5x'FT= 0 .............'
     +,' Film type for SlideMaker ..........'/
     +,5x'BC= 0 .............'
     +,' Background color for SlideMaker ...'/
     +,5x'DV= 0 .............'
     +,' Target hardcopy device ............'/
     +,5x'PO=             ...'
     +,' Plot offsets (x,y) ................ In inches.'/
     +,5x'SF=             ...'
     +,' Overall scale factors (x,y) ....... Enlarge/Shrink.'/
     +,5x'ID=',30X,' ... Plot ID label.'/
     +,5x'OD=',30X,' ... Optional destination for hardcopy.')
     	CALL IFANSI_VIDEO(90)
     	WRITE(6,1001)
1001	FORMAT(X,80(' '))
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1002)
1002	FORMAT(' To change the setup, enter AC=parameters where AC',
     +' is the 2 letter Access-Code'/' for the setup parameter.   ',
     +' Enter HELP AC to get more information on setup AC.'/
     +' Enter GO/PF1 to send hardcopy, EXIT/PF4 to quit, REF/PF3',
     +' to refresh screen.')
     	CALL IFANSI_VIDEO(90)
     	WRITE(6,1003)
1003	FORMAT(X,80(' '))
     	CALL IFANSI_VIDEO(47)
     	WRITE(6,1005)
1005	FORMAT(' oops:')
     	RETURN
     	END

     	SUBROUTINE IFCOPY_DATA(ICODE)
C
C	THIS ROUTINE INSERTS HARDCOPY PAGE-SETUP PARAMETERS.
C
     	CHARACTER OUTPUT*32, IDPLOT*32
     	COMMON/IFCOPY/ SETUP(20), OUTPUT, IDPLOT
     	CHARACTER DEVICE*25, TEXT*16

     	I = ICODE
     	CALL IFANSI_VIDEO(30)
    	IF(I.EQ.0.OR.I.EQ.2) CALL IFANSI_IFL(INT(SETUP(2)),1,'I2',2,8)
    	IF(I.EQ.0.OR.I.EQ.3) CALL IFANSI_IFL(INT(SETUP(3)),1,'I2',3,8)
    	IF(I.EQ.0.OR.I.EQ.4) CALL IFANSI_IFL(INT(SETUP(4)),1,'I2',4,8)
     	IF(I.EQ.0.OR.I.EQ.7) CALL IFANSI_IFL(INT(SETUP(9)),1,'I2',5,8)
     	IF(I.EQ.0.OR.I.EQ.8) CALL IFANSI_IFL(INT(SETUP(10)),1,'I2',6,8)
     	IF(I.EQ.0.OR.I.EQ.9) CALL IFANSI_IFL(INT(SETUP(11)),1,'I2',7,8)
     	IF(I.EQ.0.OR.I.EQ.10) THEN
     	   ID = SETUP(12)+0.1
     	   CALL IFANSI_IFL(ID,1,'I2',8,8)
     	   TEXT = ' '
     	   IF( ID.EQ.1 ) TEXT = 'Ektachrome-100'
     	   IF( ID.EQ.2 ) TEXT = 'Polaroid polac'
     	   CALL IFANSI_TEXT( TEXT, 16, 8, 61 )
     	ENDIF
     	IF(I.EQ.0.OR.I.EQ.11) THEN
     	   ID = SETUP(13)+0.1
     	   CALL IFANSI_IFL(ID,1,'I2',9,8)
     	   TEXT = ' '
     	   IF( ID.EQ.1 ) TEXT = 'Black'
     	   IF( ID.EQ.2 ) TEXT = 'Medium-gray'
     	   IF( ID.EQ.3 ) TEXT = 'Dark-blue'
     	   IF( ID.EQ.4 ) TEXT = 'Medium-blue'
     	   IF( ID.EQ.5 ) TEXT = 'Light-gray'
     	   IF( ID.EQ.6 ) TEXT = 'Red'
     	   CALL IFANSI_TEXT( TEXT, 16, 9, 61 )
     	ENDIF
     	IF(I.EQ.0.OR.I.EQ.1) THEN
     	   ID = SETUP(1)+0.1
     	   IF( ID.LT.1 ) ID = 1
     	   IF( ID.GT.99) ID = 99
     	   CALL IFCOPY_DEVICE(ID,DEVICE)
     	   CALL IFANSI_IFL(ID,1,'I2',10,8)
     	   CALL IFANSI_TEXT(DEVICE,25,10,52)
     	   IF( ID.EQ.0 ) THEN  !DRIVER NOT FOUND
      	       SETUP(1) = 0.0
     	       CALL IFMISC_OOPS( 3, 20, 6, 'NO SUCH DEVICE' )
     	   ENDIF
     	ENDIF
    	IF(I.EQ.0.OR.I.EQ.5) CALL IFANSI_FFL(SETUP(5),2,'2F6.2',11,8)
    	IF(I.EQ.0.OR.I.EQ.6) CALL IFANSI_FFL(SETUP(7),2,'2F6.3',12,8)
     	IF(I.EQ.0.OR.I.EQ.12) CALL IFANSI_TEXT(IDPLOT,30,13,8)
     	IF(I.EQ.0.OR.I.EQ.13) CALL IFANSI_TEXT(OUTPUT,30,14,8)

     	RETURN
     	END

     	SUBROUTINE IFCOPY_DEVICE(ID,DEVICE)
C
C	THIS ROUTINE READS GRAFIT$EXE:GRAFIT.QUE FOR TARGET HARDCOPY DEVICE.
C
     	CHARACTER TEXT*80, DEVICE*(*)

     	OPEN( UNIT=13, FILE='GRAFIT$EXE:GRAFIT.QUE',
     +        STATUS='OLD', READONLY, ERR=888 )
     	IDD = 0
     	JDD = IABS(ID)
  111   READ(13,222,END=888) TEXT
  222   FORMAT(A80)
        IF( TEXT(1:1).EQ.'!' .OR. INDEX(TEXT,'.EXE').EQ.0 ) GOTO 111
     	IDD = IDD + 1
     	IF( IDD.NE.JDD ) GOTO 111
     	IDD = INDEX( TEXT, ':' )
     	IF( IDD.LT.2 ) GOTO 888
     	IF( ID.GT.0 ) THEN
     	    DEVICE = TEXT(IDD+2:)
     	ELSE
     	    DEVICE = TEXT(1:IDD-1)
     	ENDIF
     	GOTO 999
  888   ID = 0
     	DEVICE = 'Undefined.'
  999	CLOSE(13)
     	RETURN
     	END

     	SUBROUTINE IFCOPY_HELP
C
C	THIS ROUTINE DISPLAYS GRAFIT$EXE:GRAFIT.QUE
C	
     	CHARACTER TEXT*80
     	OPEN( UNIT=13, FILE='GRAFIT$EXE:GRAFIT.QUE',
     +        STATUS='OLD', READONLY, ERR=888 )
     	ID = 0
     	CALL IFANSI_CLEAR(0)
     	WRITE(6,1)
  1	FORMAT(/' A list of available hardcopy making devices:'/)
  111   READ(13,222,END=777) TEXT
  222   FORMAT(A80)
        IF( TEXT(1:1).EQ.'!' .OR. INDEX(TEXT,'.EXE').EQ.0 ) GOTO 111
     	JD = INDEX( TEXT, ':' )
     	IF( JD.LT.2 ) GOTO 111
     	ID = ID + 1
     	WRITE(6,333) ID, TEXT(JD+1:)
  333   FORMAT(I5,'>',A)
     	GOTO 111
  777	WRITE(6,778)
  778   FORMAT(/' Hit RETURN to continue...',$)
     	READ(5,222,ERR=999,END=999) TEXT(1:1)
     	GOTO 999
  888	CALL IFMISC_OOPS( 9, 20, 6, ' ' )
  999	CLOSE(13)
     	RETURN
     	END
     	SUBROUTINE IFCURV( NPT, ISP, X, Y )
C
C  PROGRAMMER: RONG-SHENG ZHOU
C	       ALFRED UNIVERSITY	JULY-1985
C
C	THIS ROUTINE IMPLEMENTS A POLYLINE FUNCTION.
C
C       NPT --- NUMBER OF VERTICES IN THE ARRAY.
C	ISP --- SPLINE-CURVE FLAG: 0=OFF, 1=ON.
C
C       X,Y --- ARRAY OF SCALED ORDINATE AND ABCISSA VALUES.
C
     	LOGICAL   SPLINE
	DIMENSION X(1), Y(1)
C
C  INITIALIZE...
C
     	NN = IABS(NPT)
    	X0 = X(1)
    	Y0 = Y(1)
     	CALL IFPLOT( X0, Y0, 3 )
     	SPLINE = .FALSE.
     	IF( ISP.NE.0 .AND. NN.GT.2 ) SPLINE = .TRUE.
	IF( SPLINE ) THEN
    	    U  = X(2)-X(1)
    	    V  = Y(2)-Y(1)
    	    U1 = X(NN)-X(NN-1)
    	    V1 = Y(NN)-Y(NN-1)
    	    SU = U
    	    SV = V
    	    IF( X(1).NE.X(NN) .OR. Y(1).NE.Y(NN) ) THEN
     		SU = X(NN-1)-X(NN-2)
     		SV = Y(NN-1)-Y(NN-2)
     		CALL IFCURV_REFLX(U1,V1,SU,SV)
     		U1 = X(3)-X(2)
     		V1 = Y(3)-Y(2)
     		CALL IFCURV_REFLX(U,V,U1,V1)
     	    ENDIF
     	ENDIF
C
C  TAKE CARE OF THE REST OF VERTICES...
C
     	DO I=2, NN
     	   IF( IFCTRL_C() ) RETURN
    	   XN = X(I)
    	   YN = Y(I)
     	   IF( SPLINE ) THEN
     	       IF( I.LT.NN ) THEN
     		   U2 = X(I+1) - XN
     		   V2 = Y(I+1) - YN
     	       ELSE
     		   U2 = SU
     		   V2 = SV
     	       ENDIF
     	       J = IFCURV_FIT4( X0,Y0,XN,YN,U1,V1,U2,V2 )
     	       IF( J.NE.0 ) CALL IFPLOT( XN, YN, 2 )
    	       U1 = U
    	       V1 = V
    	       U  = U2
    	       V  = V2
     	   ELSE
     	       CALL IFPLOT( XN, YN, 2 )
     	   ENDIF
    	   X0 = XN
    	   Y0 = YN
     	ENDDO
     	RETURN
	END

     	FUNCTION IFCURV_FIT4(PX1,PY1,PX2,PY2,VECX1,VECY1,VECX3,VECY3)
	X1=PX1
	Y1=PY1
     	X2=PX2
     	Y2=PY2
    	VX3=PX2-X1
	VY3=PY2-Y1
	VX2=VECX1
	VY2=VECY1
	D2=VX2*VX2+VY2*VY2
	T=1.
	GO TO 7
  6	T=0.
	VX2=VX3
	VY2=VY3
	VX3=VECX3
	VY3=VECY3
	D2=D3
	UX1=UX2
	UY1=UY2
  7	D3=VX3*VX3+VY3*VY3
	UX2=D2*VX3+D3*VX2
	UY2=D2*VY3+D3*VY2
     	D = UX2*UX2+UY2*UY2
     	IF( D.EQ.0.0 ) THEN
     	    IFCURV_FIT4 = 1
     	    RETURN
     	ENDIF
	DV=1.0/SQRT(D)
	UX2=DV*UX2
	UY2=DV*UY2
	IF(T)6,8,6
  8	D=ABS(UX1*VX2+UY1*VY2)
	D1=D
	UUX1=D*UX1
	UUY1=D*UY1
	D=ABS(UX2*VX2+UY2*VY2)
	UUX2=D*UX2
	UUY2=D*UY2
	D=D+D1
	AX=UUX2+UUX1-VX2-VX2
	BX=VX2-UUX1-AX
	AY=UUY2+UUY1-VY2-VY2
	BY=VY2-UUY1-AY
	N=10.*D+1.
	D=1.0/FLOAT(N)
	DO I=1, N
     	   T = T+D
     	   X = ((AX*T+BX)*T+UUX1)*T+X1
     	   Y = ((AY*T+BY)*T+UUY1)*T+Y1
     	   CALL IFPLOT( X,Y,2 )
     	ENDDO
     	IFCURV_FIT4 = 0
     	RETURN
     	END

     	SUBROUTINE IFCURV_REFLX(VX1,VY1,VX2,VY2)
	PS=VY1*VY1
	DS=VX1*VX1
	SS=DS+PS
    	IF( SS.NE.0.0 ) THEN
	    DS=DS-PS
	    PS=2.0*VX1*VY1
	    TEMP=(PS*VY2+VX2*DS)/SS
	    VY2=(PS*VX2-VY2*DS)/SS
	    VX2=TEMP
     	ENDIF
	RETURN
	END

     	SUBROUTINE IFCURV_VECT( NPT, ISP, X, Y )
C
C  PROGRAMMER: RONG-SHENG ZHOU
C	       ALFRED UNIVERSITY	JULY-1985
C
C	THIS ROUTINE IMPLEMENTS A POLYLINE FUNCTION.
C
C       NPT --- NUMBER OF VERTICES IN THE ARRAY.
C	ISP --- SPLINE-CURVE FLAG: 0=OFF, 1=ON.
C
C       X,Y --- ARRAY OF SCALED ORDINATE AND ABCISSA VALUES.
C
     	LOGICAL   SPLINE
	DIMENSION X(1), Y(1)
C
C  INITIALIZE...
C
     	NN = IABS(NPT)
    	X0 = X(1)
    	Y0 = Y(1)
     	CALL IFPLOT_VECT( X0, Y0, 3 )
     	SPLINE = .FALSE.
     	IF( ISP.NE.0 .AND. NN.GT.2 ) SPLINE = .TRUE.
	IF( SPLINE ) THEN
    	    U  = X(2)-X(1)
    	    V  = Y(2)-Y(1)
    	    U1 = X(NN)-X(NN-1)
    	    V1 = Y(NN)-Y(NN-1)
    	    SU = U
    	    SV = V
    	    IF( X(1).NE.X(NN) .OR. Y(1).NE.Y(NN) ) THEN
     		SU = X(NN-1)-X(NN-2)
     		SV = Y(NN-1)-Y(NN-2)
     		CALL IFCURV_VECT_REFLX(U1,V1,SU,SV)
     		U1 = X(3)-X(2)
     		V1 = Y(3)-Y(2)
     		CALL IFCURV_VECT_REFLX(U,V,U1,V1)
     	    ENDIF
     	ENDIF
C
C  TAKE CARE OF THE REST OF VERTICES...
C
     	DO I=2, NN
     	   IF( IFCTRL_C() ) RETURN
    	   XN = X(I)
    	   YN = Y(I)
     	   IF( SPLINE ) THEN
     	       IF( I.LT.NN ) THEN
     		   U2 = X(I+1) - XN
     		   V2 = Y(I+1) - YN
     	       ELSE
     		   U2 = SU
     		   V2 = SV
     	       ENDIF
     	       J = IFCURV_VECT_FIT4( X0,Y0,XN,YN,U1,V1,U2,V2 )
     	       IF( J.NE.0 ) CALL IFPLOT_VECT( XN, YN, 2 )
    	       U1 = U
    	       V1 = V
    	       U  = U2
    	       V  = V2
     	   ELSE
     	       CALL IFPLOT_VECT( XN, YN, 2 )
     	   ENDIF
    	   X0 = XN
    	   Y0 = YN
     	ENDDO
     	RETURN
	END

     	FUNCTION IFCURV_VECT_FIT4(PX1,PY1,PX2,PY2,VECX1,
     +  VECY1,VECX3,VECY3)
	X1=PX1
	Y1=PY1
     	X2=PX2
     	Y2=PY2
    	VX3=PX2-X1
	VY3=PY2-Y1
	VX2=VECX1
	VY2=VECY1
	D2=VX2*VX2+VY2*VY2
	T=1.
	GO TO 7
  6	T=0.
	VX2=VX3
	VY2=VY3
	VX3=VECX3
	VY3=VECY3
	D2=D3
	UX1=UX2
	UY1=UY2
  7	D3=VX3*VX3+VY3*VY3
	UX2=D2*VX3+D3*VX2
	UY2=D2*VY3+D3*VY2
     	D = UX2*UX2+UY2*UY2
     	IF( D.EQ.0.0 ) THEN
     	    IFCURV_VECT_FIT4 = 1
     	    RETURN
     	ENDIF
	DV=1.0/SQRT(D)
	UX2=DV*UX2
	UY2=DV*UY2
	IF(T)6,8,6
  8	D=ABS(UX1*VX2+UY1*VY2)
	D1=D
	UUX1=D*UX1
	UUY1=D*UY1
	D=ABS(UX2*VX2+UY2*VY2)
	UUX2=D*UX2
	UUY2=D*UY2
	D=D+D1
	AX=UUX2+UUX1-VX2-VX2
	BX=VX2-UUX1-AX
	AY=UUY2+UUY1-VY2-VY2
	BY=VY2-UUY1-AY
	N=10.*D+1.
	D=1.0/FLOAT(N)
	DO I=1, N
     	   T = T+D
     	   X = ((AX*T+BX)*T+UUX1)*T+X1
     	   Y = ((AY*T+BY)*T+UUY1)*T+Y1
     	   CALL IFPLOT_VECT( X,Y,2 )
     	ENDDO
     	IFCURV_VECT_FIT4 = 0
     	RETURN
     	END

     	SUBROUTINE IFCURV_VECT_REFLX(VX1,VY1,VX2,VY2)
	PS=VY1*VY1
	DS=VX1*VX1
	SS=DS+PS
    	IF( SS.NE.0.0 ) THEN
	    DS=DS-PS
	    PS=2.0*VX1*VY1
	    TEMP=(PS*VY2+VX2*DS)/SS
	    VY2=(PS*VX2-VY2*DS)/SS
	    VX2=TEMP
     	ENDIF
	RETURN
	END

     	SUBROUTINE IFFEED( ARRAY, PLOTID, OUTPUT )
C
C  PROGRAMMER: R.S. ZHOU		SEP-1986
C
C	THIS ROUTINE DUMPS THE HARDCOPY.
C
C	ARRAY --- ARRAY THAT CONTAINS THE INITIALIZATON PARAMETERS.
C
C	ARRAY(1): HARDCOPY DEVICE NUMBER.
C	ARRAY(2): NUMBER OF HARDCOPIES.
C	ARRAY(3): PLOT ID FLAG.
C	ARRAY(4): PAGE FEED FLAG.
C	ARRAY(5): HARDCOPY SETUP PARAMETER 1 (OFFSET X).
C	ARRAY(6): HARDCOPY SETUP PARAMETER 2 (OFFSET Y).
C	ARRAY(7): HARDCOPY SETUP PARAMETER 3 (SCALE  X).
C	ARRAY(8): HARDCOPY SETUP PARAMETER 4 (SCALE  Y).
C	........  ........
C	ARRAY(20): HARDCOPY SETUP PARAMETER 16.
C
C	PLOTID: PLOT ID LABEL
C	OUTPUT: OPTIONAL HARDCOPY DESTINATION
C
     	INCLUDE   'TEKLIB.CBS'
     	CHARACTER HCNAME*80, PRINT*16, IMAGE*16, PLOTID*(*)
     	CHARACTER SAVEOD*32, ODSAVE*32, OUTPUT*(*)
     	DIMENSION SETUP(20), ARRAY(1)
     	DATA SAVEOD / ' ' /
     	DATA SETUP/ 1.,1.,1.,1.,0,0,1.,1.,1.,0,5.,1.,1.,0,0,0,0,0,0,0 /
     	SAVE      SAVEOD
C
C  IF META-FILE NOT PRESENT, RETURN...
C
     	IF( IDF.EQ.0 ) THEN
     	    CALL IFMISC_OOPS( 12, 0, 0, ' ' )
     	    RETURN
     	ENDIF
C
C  INITIALIZE THE PAGE SETUP...
C
     	IF( ARRAY(1).NE.0.0 ) THEN
     	    DO  I=1, 20
     		SETUP(I) = ARRAY(I)
     	    ENDDO
     	ENDIF
     	ODSAVE = OUTPUT
     	IF(IF_DCL_HARDCOPY()) CALL IF_DCL_HPAR(SETUP(1),PLOTID,ODSAVE)
     	IDEV = SETUP(1)+0.1
     	IF( IDEV.LT.1 ) IDEV = 1
     	IF( IDEV.GT.99) IDEV = 99
C
C  DUMP THE LAST "PLOT" BUFFER IF NOT EMPTY...
C
     	IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
C
C  GET THE CURRENT GRAPH ORIGIN...
C
     	XORG = SETUP(5) + FLOAT(IXO)/FUNI
     	YORG = SETUP(6) + FLOAT(IYO)/FUNI
C
C  WRAP UP THE "DI" FILE...
C
     	IF( SETUP(3).NE.0.0 .AND. PLOTID.NE.' ' ) THEN	!PLOT ID
     	    L1 = IFMISC_LENG( PLOTID )
     	    WRITE(IDF,1000) -XORG-XORS, -YORG-YORS, L1, PLOTID(1:L1)
     	ENDIF
1000	FORMAT('SPEN:  1'/'SCAL: 1.0, 1.0'/
     +'PLOT:',2F6.3,'-3 0.000 1.000 2 0.000 0.000 3 3.000 0.000 2'/
     +'TEXT:',I3,'   0.050   0.050   0.080   0.080   0.000,',A)
     	WRITE(IDF,1001) INT(SETUP(4))
1001	FORMAT('FEED:',I3)
C
C  GET THE COMPLETE NAME OF DI FILE...
C
     	INQUIRE( UNIT=IDF, NAME=DINAME )
     	CLOSE(UNIT=IDF)
     	IDW = 0
C
C  OPEN A BATCH COMMAND FILE...
C
     	DTNAME = DINAME
     	CALL IFMISC_NAMEXT( DTNAME, '.BC' )
     	OPEN(UNIT=IDF,FILE=DTNAME,STATUS='NEW',FORM='FORMATTED',
     +       CARRIAGECONTROL='LIST')
C
C  GET THE HARDCOPY DRIVER...
C
     	HCNAME = DINAME
     	IDEV   = -IDEV
     	CALL IFCOPY_DEVICE(IDEV,IMAGE)
     	IF( IDEV.NE.0 ) THEN
     	    PRINT(1:1) = '.'
     	    PRINT(2:3) = IMAGE(1:2)
     	    CALL IFMISC_NAMEXT( HCNAME, PRINT(1:3) )
     	    PRINT(1:2) = IMAGE(1:2)
     	    PRINT(3: ) = '_PRINT'
     	ELSE
     	    WRITE(6,1234)
 1234   FORMAT('_%HARDCOPY: can''t find target hardcopy device driver.')
     	ENDIF
     	CALL IFMISC_STRIP(ODSAVE)
     	IF( ODSAVE.EQ.' ' ) ODSAVE = SAVEOD
     	IF( ODSAVE.NE.' ' ) HCNAME = ODSAVE
C
C  WRITE THE COMMAND FILE FOR BATCHJOB...
C
     	NCOPY = SETUP(2)+0.1
     	IF( NCOPY.LT.1 ) NCOPY = 1
     	IF( NCOPY.GT.99) NCOPY = 99
     	L1 = IFMISC_LENG( DINAME )
     	L2 = IFMISC_LENG( HCNAME )
     	L3 = IFMISC_LENG(  IMAGE )
     	L4 = IFMISC_LENG(  PRINT )
     	IF( ODSAVE.EQ.'TT:' .OR. ODSAVE.EQ.'PP:' ) GOTO 3333
     	WRITE(IDF,2000) IMAGE(1:L3), DINAME(1:L1), HCNAME(1:L2),
     +                  (SETUP(I),I=5,20)
2000	FORMAT('$! GRAFIT hardcopy command file.'/
     +'$ RUN GRAFIT$EXE:',A,/,A,/,A,/,'INIT:',16F7.2)
     	IF( ODSAVE.EQ.' ' ) THEN
     	    IF( NCOPY.LT.2 ) THEN
     		WRITE(IDF,2001) PRINT(1:L4), HCNAME(1:L2)
2001		FORMAT('$ ',A,1X,A)
     	    ELSE
     		IF( NCOPY.LT.10 ) THEN
      		    WRITE(IDF,2002) PRINT(1:L4), HCNAME(1:L2), NCOPY
                ELSE
     		    WRITE(IDF,2003) PRINT(1:L4), HCNAME(1:L2), NCOPY
                ENDIF
2002		FORMAT('$ ',A,1X,A,'/COPIES=',I1)
2003		FORMAT('$ ',A,1X,A,'/COPIES=',I2)
     	    ENDIF
     	ENDIF
     	CLOSE( UNIT=IDF )
C
C  SEND IT TO THE HARDCOPY QUEUE...
C
      	CALL IFFEED_QUEUE( DTNAME )
     	GOTO 999
C
C  DUMP HARDCOPY TO THE TERMINAL LINE...
C
3333	WRITE(IDF,3000) DINAME(1:L1),HCNAME(1:L2),(SETUP(I),I=5,20)
3000	FORMAT(A,/,A,/,'INIT:',16F7.2)
     	CLOSE(UNIT=IDF)
     	IDF = 46                     !MASK: 101110
     	DINAME = 'RUN GRAFIT$EXE:'
     	DINAME(16:) = IMAGE
     	CALL LIB$SPAWN( DINAME, DTNAME,, IDF )
     	CALL LIB$DELETE_FILE( DTNAME )
999	IDF = 0
     	SAVEOD = ODSAVE
     	RETURN
     	END

      SUBROUTINE IFFEED_QUEUE( FNAME )
C
C     THIS ROUTINE SUBMITS A HARDCOPY TO A BATCH QUEUE
C     USING SYSTEM SERVICE ROUTINE SYS$SNDJBC...
C     (THE QUEUE NAME IS READ FROM GRAFIT$EXE:GRAFIT.QUE)...
C
      INTEGER*4 SYS$SNDJBC
      INCLUDE   '($SJCDEF)'
      STRUCTURE / ITMLST /
          UNION
            MAP
               INTEGER*2 BUFLEN, ITMCOD
               INTEGER*4 BUFADR, RETADR
            END MAP
            MAP
               INTEGER*4 ENDLST
            END MAP
          END UNION
      END STRUCTURE
      RECORD /ITMLST/ SUBMIT_LIST(6)
      CHARACTER QUEUE*32, FNAME*(*)
C
C  INITIALIZE ITEM LIST FOR THE ENTER_FILE OPERATION...
C
      NQ = IFFEED_QNAME( QUEUE )
      IF( NQ.EQ.0 ) THEN                      !QUEUE NOT SPECIFIED
          QUEUE = 'SYS$BATCH'
          NQ = 9
      ENDIF
      SUBMIT_LIST(1).BUFLEN = NQ              !LOAD QUEUENAME
      SUBMIT_LIST(1).ITMCOD = SJC$_QUEUE
      SUBMIT_LIST(1).BUFADR = %LOC( QUEUE )
      SUBMIT_LIST(1).RETADR = 0
      NCH = IFMISC_LENG( FNAME )
      SUBMIT_LIST(2).BUFLEN = NCH             !LOAD FILENAME
      SUBMIT_LIST(2).ITMCOD = SJC$_FILE_SPECIFICATION
      SUBMIT_LIST(2).BUFADR = %LOC( FNAME )
      SUBMIT_LIST(2).RETADR = 0
      SUBMIT_LIST(3).BUFLEN = 0               !NO LOG FILE
      SUBMIT_LIST(3).ITMCOD = SJC$_NO_LOG_SPECIFICATION
      SUBMIT_LIST(3).BUFADR = 0
      SUBMIT_LIST(3).RETADR = 0
      SUBMIT_LIST(4).BUFLEN = 0               !DELETE
      SUBMIT_LIST(4).ITMCOD = SJC$_DELETE_FILE
      SUBMIT_LIST(4).BUFADR = 0
      SUBMIT_LIST(4).RETADR = 0
      SUBMIT_LIST(5).BUFLEN = 0               !NO NOTIFY
      SUBMIT_LIST(5).ITMCOD = SJC$_NO_NOTIFY
      SUBMIT_LIST(5).BUFADR = 0
      SUBMIT_LIST(5).RETADR = 0
      SUBMIT_LIST(6).ENDLST = 0               !END OF THE LIST
C
C  SEND THE JOB...
C
      NCH = SYS$SNDJBC(, %VAL(SJC$_ENTER_FILE),, SUBMIT_LIST,,,)
      IF( .NOT.NCH ) THEN
          CALL LIB$SIGNAL( %VAL(NCH) )
      ELSE
          WRITE(6,1000) QUEUE(1:NQ)
 1000     FORMAT(' HARDCOPY> hardcopy queued in ',A)
      ENDIF
      RETURN
      END

      FUNCTION IFFEED_QNAME( QUEUE )
C
C     THIS ROUTINE GETS HARDCOPY QUEUE_NAME FROM GRAFIT$EXE:GRAFIT.QUE.
C
      CHARACTER TEXT*80, QUEUE*(*)

      OPEN( UNIT=13, FILE='GRAFIT$EXE:GRAFIT.QUE',
     +      STATUS='OLD', READONLY, ERR=888 )
  111 READ(13,222,END=888) TEXT
  222 FORMAT(A80)
      IF( TEXT.EQ.' ' .OR. TEXT(1:1).EQ.'!' ) GOTO 111
      NQ = INDEX( TEXT, 'QNAME>' )
      IF( NQ.EQ.0 ) GOTO 111
      QUEUE = TEXT(NQ+6:)
      IFFEED_QNAME = IFMISC_LENG(QUEUE)
      GOTO 999
  888 IFFEED_QNAME = 0
  999 CLOSE(13)
      RETURN
      END

    	SUBROUTINE IFFILL( IPT )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE IMPLEMENTS AREA/POLYGON FILL.
C
C	IPT >0< : START AREA/POLYGON FILL.
C	IPT = 0 : TERMINATE AREA FILL.
C	IPT > 0 : EDGE/OUTLINE THE FILLED AREA.
C	IPT < 0 : DO NOT EDGE/OUTLINE THE FILLED AREA.
C
    	INCLUDE 'TEKLIB.CBS'
C
C  QUIT ON CTRL_C...
C
     	IF( CTRL_C .OR. IPT.EQ.IFP ) RETURN
     	IF( IPT.NE.0 ) THEN
     	    IFP = IPT
     	ELSE
     	    CALL IFFILL_INIT(0)
     	    IFP = 0
     	ENDIF
     	IFF = 0

     	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) IPT
     	ENDIF
1000	FORMAT('FILL:',I3)

999	RETURN
    	END

     	SUBROUTINE IFFILL_INIT( ICOD )
C
C	THIS ROUTINE IMPLEMENTES POLYGON FILL.
C
     	INCLUDE 'TEKLIB.CBS'
     	SAVE INIT

    	IF( ITM.EQ.1 ) RETURN
     	IF( ICOD.EQ.0 ) GOTO 222	!END ALL PANELS
     	IF( INIT.EQ.999 ) GOTO 111	!BEGIN NEW PANEL
C
C  SELECT THE FILL PATTERN FOR ALL PANELS...
C
     	IF( ITM.EQ.2 ) THEN		!TEK-4100 GRAPHICS
    	    IF( IPL.GT.MBS-6 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC		!<ESC>MP color-index
    	    IPB(IPL+2) = 'M'
    	    IPB(IPL+3) = 'P'
    	    IPL = IPL + 3
    	    IF( IFP.EQ.1 ) THEN
     		CALL IFPACK_TEKINT( -ILP )		!SOLID COLOR
    	    ELSE
     		CALL IFPACK_TEKINT( IABS(IFP-1) )	!PREDEFINED PATTERN
    	    ENDIF
     	ENDIF
     	IF( ITM.EQ.3 ) THEN		!REGIS GRAPHICS
    	    IF( IPL.GT.MBS-3 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = '@'		!OPEN MACROGRAPH "P"
     	    IPB(IPL+2) = ':'
     	    IPB(IPL+3) = 'P'
     	    IPL = IPL + 3
     	ENDIF
     	INIT = 999
C
C  BEGIN NEW PANEL ...
C
  111	IF( ITM.EQ.2 ) THEN
     	    IF( IPL.GT.MBS-9 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = ESC			!<ESC>LP last-pen-location
    	    IPB(IPL+2) = 'L'
    	    IPB(IPL+3) = 'P'
    	    IPL = IPL + 3
    	    CALL IFPACK_TEKXY( IXL, IYL )
    	    IPL = IPL + 1
    	    IPB(IPL) = '1'
     	ENDIF
    	GOTO 999

  222	IF( INIT.NE.999 ) GOTO 999
C
C  END ALL PANELS ...
C
     	IF( ITM.EQ.2 ) THEN
     	    IF( IPL.GT.MBS-3 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = ESC			!<ESC>LE
    	    IPB(IPL+2) = 'L'
    	    IPB(IPL+3) = 'E'
    	    IPL = IPL + 3
     	ENDIF
     	IF( ITM.EQ.3 ) THEN
     	    IF( IPL.GT.MBS-21 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = '@'		!CLOSE THE MACROGRAPH
     	    IPB(IPL+2) = ';'
     	    IPB(IPL+3) = 'F'		!FILL THE POLYGON
     	    IPB(IPL+4) = '('
     	    IPB(IPL+5) = 'W'
     	    IPB(IPL+6) = '('
     	    IPB(IPL+7) = 'I'
     	    IPL = IPL + 7
     	    CALL IFPACK_REGIS(IABS(IFP))
     	    IPB(IPL+1) = ')'
     	    IPB(IPL+2) = ','
     	    IPB(IPL+3) = '@'
     	    IPB(IPL+4) = 'P'
     	    IPB(IPL+5) = ')'
     	    IPL = IPL + 5
     	    IF( IFP.GT.0 ) THEN		!OUTLINE THE POLYGON
     		IPB(IPL+1) = '@'
     		IPB(IPL+2) = 'P'
     		IPL = IPL + 2
     	    ENDIF
     	    IPB(IPL+1) = '@'		!CLEAR MACROGRAPH "P"
     	    IPB(IPL+2) = ':'
     	    IPB(IPL+3) = 'P'
     	    IPB(IPL+4) = '@'
     	    IPB(IPL+5) = ';'
     	    IPL = IPL + 5
     	ENDIF
     	INIT = 0

 999	RETURN
    	END

     	SUBROUTINE IFFILL_PANEL( ICODE )
C
C	THIS ROUTINE ENABLES OR DISABLES NEW PANEL FOR POLYGON FILL.
C
     	INCLUDE 'TEKLIB.CBS'
     	NEW = ICODE
     	IF( NEW.NE.0 ) NEW = 1
     	IF( ITM.EQ.3 ) NEW = 0
     	RETURN
     	END

	SUBROUTINE IFFONT( IFONT )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, JUNE-1988
C
C	THIS ROUTINE SELECTS ACTIVE FONT FOR TEXT DRAWING.
C
C	IFONT = 1: STANDARD FONT AS DEFINED IN "IFINIT".
C	IFONT = 2: ITALIC STANDARD FONT.
C	IFONT = 3: BOLDFACE STANDARD FONT.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( IFONT.EQ.IFN .OR. IFONT.LT.1 .OR. IFONT.GT.3 ) GOTO 999

     	IF( ITM.EQ.1 ) GOTO 888

     	IF( IFONT.EQ.2 .OR. IFN.EQ.2 ) THEN
    	    IF( ITM.EQ.2 ) THEN		!TEK-4100
     		IF( IPL.GT.MBS-7 ) CALL IFINIT_DUMP
     		IPB(IPL+1) = ESC		!<ESC>MA slant-angle
     		IPB(IPL+2) = 'M'
     		IPB(IPL+3) = 'A'
     		IPL = IPL + 3
     		IF( IFONT.EQ.2 ) CALL IFPACK_TEKINT( 15 )
     		IF(   IFN.EQ.2 ) CALL IFPACK_TEKINT(  0 )
     		IPL = IPL + 1
     		IPB(IPL) = '0'
     	    ENDIF
     	    IF( ITM.EQ.3 ) THEN		!REGIS
     		IF( IPL.GT.MBS-8 ) CALL IFINIT_DUMP
     		IPB(IPL+1) = 'T'
     		IPB(IPL+2) = '('
     		IPB(IPL+3) = 'I'
     		IPL = IPL + 3
     		IF( IFONT.EQ.2 ) CALL IFPACK_REGIS( 15 )
     		IF(   IFN.EQ.2 ) CALL IFPACK_REGIS(  0 )
     		IPL = IPL + 1
     		IPB(IPL) = ')'
     	    ENDIF
     	ENDIF

888	IFN = IFONT
     	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) IFN
     	ENDIF
1000	FORMAT('FONT:',I3)

999	RETURN
	END

    	SUBROUTINE IFGIN_ABLE( MODE )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE ENABLES OR DISABLES GIN ON TEK-4100 SERIES TERMINALS.
C
C		MODE=0: DISABLE GIN
C		MODE>0: ENABLE FOR LOCATOR MODE
C		MODE<0: ENABLE FOR PICKER MODE
C		|MODE| = CURSOR COLOR
C
    	INCLUDE		'TEKLIB.CBS'
    	DIMENSION	ICMAP(3,8)
     	COMMON/IFGINS/  MD
C
C  GIN CURSOR COLOR MAP....
C
    	DATA ICMAP(1,1), ICMAP(2,1), ICMAP(3,1) /   0, 100,   0 /
    	DATA ICMAP(1,2), ICMAP(2,2), ICMAP(3,2) / 120,  50, 100 /
    	DATA ICMAP(1,3), ICMAP(2,3), ICMAP(3,3) / 240,  50, 100 /
    	DATA ICMAP(1,4), ICMAP(2,4), ICMAP(3,4) /   0,  50, 100 /
    	DATA ICMAP(1,5), ICMAP(2,5), ICMAP(3,5) / 300,  50, 100 /
    	DATA ICMAP(1,6), ICMAP(2,6), ICMAP(3,6) /  60,  50, 100 /
    	DATA ICMAP(1,7), ICMAP(2,7), ICMAP(3,7) / 180,  50, 100 /
    	DATA ICMAP(1,8), ICMAP(2,8), ICMAP(3,8) /   0,   0,   0 /

     	ICODE = MODE
    	IF( ICODE.EQ.0 ) THEN		!DISABLE GIN
     	    IF( MD.EQ.0 ) RETURN
    	    IF( IPL.GT.MBS-4 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC
    	    IPB(IPL+2) = 'I'
    	    IPB(IPL+3) = 'D'
    	    IF( MD.GT.0 ) IPB(IPL+4) = '0'
    	    IF( MD.LT.0 ) IPB(IPL+4) = '1'
    	    IPL = IPL + 4
    	    CALL IFINIT_DUMP
     	    READ(5,*,ERR=999,END=999)
    	ELSE				!ENABLE GIN
     	    IF( IPL.GT.MBS-22 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = ESC
    	    IPB(IPL+2) = 'I'
    	    IPB(IPL+3) = 'C'
    	    IF( ICODE.GT.0 ) IPB(IPL+4) = '0'
    	    IF( ICODE.LT.0 ) IPB(IPL+4) = '1'
    	    IPB(IPL+5) = '0'
    	    IPB(IPL+6) = ESC
    	    IPB(IPL+7) = 'T'
    	    IPB(IPL+8) = 'C'
    	    IPL = IPL + 8
    	    CALL IFPACK_TEKINT( ICMAP(1,IABS(ICODE)) )
    	    CALL IFPACK_TEKINT( ICMAP(2,IABS(ICODE)) )
    	    CALL IFPACK_TEKINT( ICMAP(3,IABS(ICODE)) )
    	    IPB(IPL+1) = ESC
    	    IPB(IPL+2) = 'I'
    	    IPB(IPL+3) = 'E'
    	    IF( ICODE.GT.0 ) IPB(IPL+4) = '0'
    	    IF( ICODE.LT.0 ) IPB(IPL+4) = '1'
    	    IPB(IPL+5) = '0'
    	    IPL = IPL + 5
    	ENDIF
     	CALL IFINIT_DUMP
    	MD = ICODE

999	RETURN
    	END

    	FUNCTION IFGIN_REPORT( NSG, XCP, YCP )
C
C  PROGRAMMER: R.S. ZHOU	JUNE-1986
C
C	THIS ROUTINE READS AND DECODES THE GIN LOCATOR OR PICK REPORT
C	AND RETURNS WITH
C
C	IFGIN_REPORT ------- KEY PRESSED.
C	NSG ---------------- SEGMENT NUMBER PICKED IF ANY.
C	XCP,YCP ------------ CURSOR POSITION RELATIVE TO GRAPH ORIGIN.
C
    	INCLUDE         'TEKLIB.CBS'
    	BYTE             REPORT(16)
     	CHARACTER	 TEXT*16
     	EQUIVALENCE	(TEXT,REPORT)
     	COMMON/IFGINS/   MD
C
C  READ A GIN REPORT...
C
  111	READ(5,222,ERR=111,END=888) REPORT
  222	FORMAT(16A1)
     	IF( TEXT.EQ.' ' ) GOTO 888
     	KEY = REPORT(1)
C
C  DECODE THE CURSOR LOCATION...
C
    	IHY = REPORT(2) - 32
    	IEX = REPORT(3) - 32
    	ILY = REPORT(4) - 32
    	IHX = REPORT(5) - 32
    	ILX = REPORT(6) - 32
    	YPS = FLOAT(IHY*128+ILY*4+IEX/4-IYO)/FUNI/YSCL
    	XPS = FLOAT(IHX*128+ILX*4+IEX-4*(IEX/4)-IXO)/FUNI/XSCL
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    DET = XCTH*YCTH + XSTH*YSTH
    	    XCP = (XPS*YCTH+YPS*YSTH)/DET
    	    YCP = (YPS*XCTH-XPS*XSTH)/DET
     	ELSE
     	    XCP = XPS
     	    YCP = YPS
     	ENDIF
C
C  DECODE THE SEGMENT NUMBER...
C
     	IF( MD.LT.0 ) THEN
    	    IHI = REPORT(7) - 32
    	    IHJ = REPORT(8) - 32
    	    ILI = REPORT(9) - 32
    	    NSG = IHI*1024 + IHJ*16 + ILI-16*(ILI/16)
    	    ILI = ILI/16
    	    ILI = ILI - 2*(ILI/2)
    	    IF( ILI.EQ.0 ) NSG = -NSG
     	ENDIF
    	GOTO 999
  888	READ(5,222,ERR=999,END=999) REPORT
     	KEY = 0
  999	IF( KEY.GT.96 .AND. KEY.LT.123 ) KEY = KEY - 32
     	IFGIN_REPORT = KEY
     	RETURN
    	END

    	SUBROUTINE IFGIN_PAP( AP )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE SETS THE APERTURE "AP" IN INCHES
C	FOR GIN PICK OF A SEGMENT.
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( IPL.GT.MBS-6 ) CALL IFINIT_DUMP
    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'I'
    	IPB(IPL+3) = 'A'
    	IPL = IPL + 3
    	PA = AP
    	IF( PA.LT.0.01 ) PA = 0.01
    	CALL IFPACK_TEKINT( INT(FUNI*PA) )

    	RETURN
    	END

     	FUNCTION IFGIN_NSEG( ID )
C
C	THIS ROUTINE CONVERTS A PICKED SEGMENT NUMBER
C	IN CASE OF SCREEN SAVING.
C
     	INCLUDE 'TEKLIB.CBS'

     	IS = ID
     	IF( NSE.GT.0 .AND. IS.GT.100 ) THEN
     	    IF( IS.LT.NSE*5101 ) THEN
     		IS = 0
     	    ELSE
     		IS = IS - NSE*5000
     	    ENDIF
     	ENDIF
     	IFGIN_NSEG = IS
     	RETURN
     	END

     	SUBROUTINE IFINIT( ITT )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		ALFRED UNIVERSITY, FEB-1986
C
C	ITT = 2: INITIALIZE A TEKTRONIX-4100 TERMINAL.
C	ITT = 3: INITIALIZE A REGIS GRAPHICS TERMINAL.
C
    	INCLUDE  'TEKLIB.CBS'
    	DIMENSION ICMAP(3,8)
    	PARAMETER (ITEK= 45)
    	BYTE      TEK_INIT(ITEK)
C
C  TEK_INIT CONTAINS THE SETUP FOR TEK-4100 TERMINALS...
C
    	DATA TEK_INIT /
     +  27,78,67,13,  		!<ESC>NCCr: SET EOM CHARACTER
     +  27,73,77,49,		!<ESC>IM 1: SET REPORT EOM FREQUENCY
     +  27,75,65,49,		!<ESC>KA1 : ENABLE DIALOG AREA
     +  27,77,81,50,		!<ESC>MQ2 : GRAPHTEXT PRECISION = STROKE
     +  27,77,71,49,		!<ESC>MG1 : WRITING MODE = OVERSTRIKE
     +  27,84,68,50,51,		!<ESC>TD 2,3  : SET ALPHA CURSOR INDICES
     +  27,84,77,51,49,49,	!<ESC>TM 3,1,1: SET COLOR MODE
     +  27,77,65,48,48,		!<ESC>MA 00   : SET CHARACTER SLANT 0
     +  27,77,82,48,48, 	!<ESC>MR 00   : SET TEXTSTRING ROTATION 0
     +  27,77,86,48 /		!<ESC>MV 0    : SET LINE TYPE INDEX
C
C  INDEX COLOR MAP....
C
    	DATA ICMAP(1,1), ICMAP(2,1), ICMAP(3,1) /   0,   0,   0 /
    	DATA ICMAP(1,2), ICMAP(2,2), ICMAP(3,2) /   0, 100,   0 /
    	DATA ICMAP(1,3), ICMAP(2,3), ICMAP(3,3) / 120,  50, 100 /
    	DATA ICMAP(1,4), ICMAP(2,4), ICMAP(3,4) / 240,  50, 100 /
    	DATA ICMAP(1,5), ICMAP(2,5), ICMAP(3,5) /   0,  50, 100 /
    	DATA ICMAP(1,6), ICMAP(2,6), ICMAP(3,6) / 300,  50, 100 /
    	DATA ICMAP(1,7), ICMAP(2,7), ICMAP(3,7) /  60,  50, 100 /
    	DATA ICMAP(1,8), ICMAP(2,8), ICMAP(3,8) / 180,  50, 100 /

     	ITM = ITT
     	IF( ITM.LT.1 .OR. ITM.GT.3 ) ITM = 1
C
C  OPEN LOGICAL UNIT "LUN" FOR THE TERMINAL GRAPHICS...
C  (THE REASON FOR OPENING SYS$OUTPUT IS TO DEFEAT THE
C  DEFAULT GENERATION OF CARRIAGE RETURN AND LINE FEED
C  ACROSS LINES FROM VAX-FORTRAN "WRITE" EVEN WHEN THE
C  "$" SIGN IS USED IN THE OUTPUT FORMAT. ON A UNIX MACHINE,
C  FOR EXAMPLE, THIS PROBLEM DOES NOT SEEM TO EXIST)...
C
     	IF( ITM.EQ.1 ) THEN
     	    LUN = 50
    	    OPEN( UNIT=LUN, FILE='SYS$OUTPUT', FORM='FORMATTED',
     +            STATUS='NEW', CARRIAGECONTROL='NONE' )
     	    CALL IFANSI_LEDS(0)
     	    GOTO 999
     	ENDIF
C
C  CLEAR THE GRAPHICS BUFFER...
C
     	DO I=1, NBS
     	   IPB(I) = NULL
     	ENDDO
    	IF( ITM.EQ.3 ) GOTO 222
C
C  SET UP IN TEK-4100...
C
    	IPB(1) = ESC		!ENTER TEK MODE: <ESC>%!0
    	IPB(2) = '%'
    	IPB(3) = '!'
    	IPB(4) = '0'
    	IPL = 4
     	IPK = 4
C
C  CLEAR THE TERMINAL MEMERY AND THE SCREEN...
C
    	CALL IFSEG_OPEN( 999999 )
    	CALL IFINIT_FRESH
C
C  SET VIEWPORT WINDOW TO BE IXM x IYM...
C
    	IPB(IPL+1) = ESC	!<ESC>RW first-corner second-corner
    	IPB(IPL+2) = 'R'
    	IPB(IPL+3) = 'W'
    	IPL = IPL + 3
    	CALL IFPACK_TEKXY( 0, 0 )
    	CALL IFPACK_TEKXY( 4095, 3132 )
C
C  LOAD INIT ARRAY...
C
    	DO I=1, ITEK
    	   IPL = IPL + 1
    	   IPB(IPL) = TEK_INIT(I)
    	ENDDO
C
C  SET DIALOG AREA COLOR MAP...
C
    	DO I=1,8
    	   CALL IFINIT_DMAP( I-1,ICMAP(1,I),ICMAP(2,I),ICMAP(3,I) )
    	ENDDO
C
C  SET GRAPHIC AREA COLOR MAP FOR SURFACE #1...
C
    	DO I=1,8
    	   CALL IFINIT_CMAP(1,I-1,ICMAP(1,I),ICMAP(2,I),ICMAP(3,I))
    	ENDDO
C
C  SET GIN PICK APERTURE...
C
    	CALL IFGIN_PAP( 0.1 )
C
C  ENABLE KEY EXPANSION OF KEY MACROS...
C
    	CALL IFMAC_KEYEXP( 1 )
C
C  SET DIALOG AREA LINES AND COLORS...
C
    	CALL IFINIT_LINE( 24 )
    	CALL IFINIT_INDEX( 1, 4, 4 )
     	GOTO 888
C
C  SET UP IN REGIS...
C
  222	IPB(1) = ESC
    	IPB(2) = 'P'
    	IPB(3) = 'p'
    	IPL = 3
     	IPK = 3
     	CALL IFINIT_REGIS
C
C  DUMP THE SETUP BUFFER...
C
  888	CALL IFINIT_DUMP
     	MBS = NBS-IPK
  999	RETURN
    	END

     	SUBROUTINE IFINIT_SESSION
C
C	THIS ROUTINE INITIALIZES A GRPAHICS SESSION FOR A PROCESS.
C
     	INCLUDE 'TEKLIB.CBS'
C
C  GET PARAMETERS BACK FROM DCL PER-PROCESS COMMON BLOCK...
C
     	CALL IF_DCL_GET
C
C  SET TERM/NOWRAP/INSERT/NOESCAPE...
C
     	CALL IFINIT_TERM( 'SET' )
C
C  OPEN LOGICAL UNIT "LUN" FOR THE TERMINAL GRAPHICS...
C
     	LUN = 50
    	OPEN( UNIT=LUN, FILE='SYS$OUTPUT', FORM='FORMATTED',
     +        STATUS='NEW', CARRIAGECONTROL='NONE' )
C
C  SET TERM/NUMERIC_KEYPAD...
C
        WRITE(LUN,1) ESC
  1     FORMAT(A1,'>',$)
C
C  INITIALIZE SOME COMMON FLAGS...
C
     	NSE = 0			!PLOT OVERLAY OFF
     	IDF = 0			!PLOT DI FILE OFF
     	IDW = 0			!PLOT DI FILE OFF
     	IXM = 4090
     	IYM = 3130
C
C  QUEUE AN ASYNCHRONOUS SYSTEM TRAP (AST) FOR "CTRL_Y" INTERRUPT...
C
     	CALL IFQAST_CTRLY
     	IF( ITM.EQ.1 ) GOTO 999
C
C  CLEAR THE GRAPHICS BUFFER...
C
     	DO I=1, NBS
     	   IPB(I) = NULL
     	ENDDO
C
C  SET UP IN TEK-4100...
C
    	IF( ITM.EQ.2 ) THEN
    	    IPB(1) = ESC	!ENTER TEK MODE: <ESC>%!0
    	    IPB(2) = '%'
    	    IPB(3) = '!'
    	    IPB(4) = '0'
    	    IPL = 4
     	    IPK = 4
     	ENDIF
C
C  SET UP IN REGIS...
C
     	IF( ITM.EQ.3 ) THEN
     	    IPB(1) = ESC
    	    IPB(2) = 'P'
    	    IPB(3) = 'p'
    	    IPL = 3
     	    IPK = 3
            IXM = 720
     	    IYM = 576
     	ENDIF
     	MBS = NBS-IPK
  999	RETURN
     	END

     	FUNCTION IFINIT_ITM( ICODE )
C
C	THIS ROUTINE REPORTS/SETS TYPE OF THE ON-LINE TERMINAL.
C
     	INCLUDE 'TEKLIB.CBS'
     	IF( ICODE.EQ.0 ) THEN
     	    IFINIT_ITM = ITM
     	ELSE
     	    ITM = ICODE
     	ENDIF
     	RETURN
     	END

     	SUBROUTINE IFINIT_CMAP( NS, INDEX, IC1, IC2, IC3 )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE DEFINES THE COLOR INDEX FOR GRAPHIC AREA
C	IN HLS SYSTEM FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	NS    : SURFACE NUMBER
C	INDEX : COLOR INDEX 0 - 15 ( 0 = SCREEN BACKGROUND INDEX )
C	IC1   : HUE ( 0 - 360 )
C	IC2   : LIGHTNESS ( 0 - 100 )
C	IC3   : SATURATION ( 0 - 100 )
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( ITM.NE.2 ) RETURN

    	NSS = NS
    	INDX = INDEX
    	LC1 = IC1
    	LC2 = IC2
    	LC3 = IC3
    	IF( NSS.LT.1 ) NSS = -1		!ALL SURFACES
    	IF( NSS.GT.4 ) NSS =  4
    	IF( INDX.LT.0 ) INDX = 0
    	IF( INDX.GT.15) INDX = 15
    	IF( LC1.LT.0 ) LC1 = 0
    	IF( LC1.GT.360 ) LC1 = 360
    	IF( LC2.LT.0 ) LC2 = 0
    	IF( LC2.GT.100 ) LC2 = 100
    	IF( LC3.LT.0 ) LC3 = 0
    	IF( LC3.GT.100 ) LC3 = 100
C
C  IF THE BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-19 ) CALL IFINIT_DUMP
C
C  <ESC>TG surface-number, color-index, color-mixture
C
    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'T'
    	IPB(IPL+3) = 'G'
    	IPL = IPL + 3
    	CALL IFPACK_TEKINT( NSS )
    	IPB(IPL+1) = '4'		!INTEGER ARRAY OF 4
    	IPL = IPL + 1
    	CALL IFPACK_TEKINT( INDX )
    	CALL IFPACK_TEKINT( LC1 )
    	CALL IFPACK_TEKINT( LC2 )
    	CALL IFPACK_TEKINT( LC3 )

    	RETURN
    	END

     	SUBROUTINE IFINIT_DMAP( INDEX, IC1, IC2, IC3 )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE DEFINES THE COLOR INDEX FOR DIALOG AREA
C	IN HLS SYSTEM FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	INDEX: COLOR INDEX 0 - 7
C	IC1  : HUE ( 0 - 360 )
C	IC2  : LIGHTNESS ( 0 - 100 )
C	IC3  : SATURATION ( 0 - 100 )
C
    	INCLUDE 'TEKLIB.CBS'

    	INDX = INDEX
    	LC1 = IC1
    	LC2 = IC2
    	LC3 = IC3
    	IF( INDX.LT.0 ) INDX = 0
    	IF( INDX.GT.7 ) INDX = 7
    	IF( LC1.LT.0 ) LC1 = 0
    	IF( LC1.GT.360 ) LC1 = 360
    	IF( LC2.LT.0 ) LC2 = 0
    	IF( LC2.GT.100 ) LC2 = 100
    	IF( LC3.LT.0 ) LC3 = 0
    	IF( LC3.GT.100 ) LC3 = 100
C
C  IF THE BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-16 ) CALL IFINIT_DUMP
C
C  <ESC>TF color-index, color-mixture
C
    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'T'
    	IPB(IPL+3) = 'F'
    	IPL = IPL + 4
    	IPB(IPL) = '4'		!INTEGER ARRAY OF 4
    	CALL IFPACK_TEKINT( INDX )
    	CALL IFPACK_TEKINT( LC1 )
    	CALL IFPACK_TEKINT( LC2 )
    	CALL IFPACK_TEKINT( LC3 )

    	RETURN
    	END

    	SUBROUTINE IFINIT_LINE( LINES )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE SETS DIALOG AREA LINES FOR TEK-4100 TERMINALS.
C
C	LINES: DIALOG AREA LINES ( 2-30 )
C	       IF -1<LINES<2, DIALOG AREA IS INVISIBLE, OTHERWISE VISIBLE.
C	       IF LINES = -1, SKIPS SETTING DIALOG AREA.
C	       IF LINES> 1, DIALOG AREA IS SET AND ERASED.
C	       IF LINES<-1, DIALOG AREA IS SET BUT NOT ERASED.
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( IF_DCL_HARDCOPY() ) RETURN

    	ILN = LINES
    	IF( ITM.NE.2 ) GOTO 999
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-15 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC		!<ESC>LV
    	IPB(IPL+2) = 'L'
    	IPB(IPL+3) = 'V'
    	IPL = IPL + 4
    	IF( ILN.GT.1 .OR. ILN.LT.0 ) GOTO 111
C
C  DAVISIBILITY NO...
C
    	IPB(IPL) = '0'
    	GOTO 222
C
C  DAVISIBILITY YES...
C
111	IPB(IPL) = '1'
    	IF( ILN.EQ.-1 ) GOTO 222
C
C  CLEAR DIALOGUE AREA IF ILN>0...
C
     	IF( ILN.GT.1 ) THEN
    	    IPB(IPL+1) = ESC		!<ESC>LZ:
    	    IPB(IPL+2) = 'L'
    	    IPB(IPL+3) = 'Z'
    	    IPL = IPL + 3
     	ENDIF
C
C  SET DIALOG AREA LINES...
C
    	IPB(IPL+1) = ESC		!<ESC>LL number-of-lines
    	IPB(IPL+2) = 'L'
    	IPB(IPL+3) = 'L'
    	IPL = IPL + 3
     	JUNK = IABS(ILN)
    	IF( JUNK.GT.30 ) JUNK = 30
    	CALL IFPACK_TEKINT( JUNK )
C
C  DUMP THE BUFFER...
C
222	CALL IFINIT_DUMP
999	IF( ILN.GT.1 ) THEN
     	    CALL IFANSI_MARGIN( 0, 0 )
     	    IF( ITM.NE.2 ) CALL IFANSI_CLEAR(0)
     	    IF( ITM.EQ.3 ) CALL IFINIT_REGIS
     	ENDIF
    	RETURN
    	END

    	SUBROUTINE IFINIT_INDEX( IDL, IDC, IDB )
C
C  PROGRAMMER: R.S. ZHOU 	FEB-1986
C
C	THIS ROUTINE SETS DIALOGUE AREA COLOR INDICES
C	FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	IDL :      LETTER COLOR INDEX( 0-7 )
C	IDC : LETTER CELL COLOR INDEX( 0-7 )
C	IDB :  BACKGROUND COLOR INDEX( 0-7 )
C
    	INCLUDE 'TEKLIB.CBS'
	DIMENSION IDAC(8)
	DATA IDAC / 0, 7, 1, 2, 4, 6, 5, 3 /

	IF( ITM.NE.2 ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-10 ) CALL IFINIT_DUMP
C
C  SET THE COLOR INDICES...
C
    	N1 = IDL
    	N2 = IDC
    	N3 = IDB
    	IF( N1.LT.0 ) N1 = 0
    	IF( N1.GT.7 ) N1 = 7
    	IF( N2.LT.0 ) N2 = 0
    	IF( N2.GT.7 ) N2 = 7
    	IF( N3.LT.0 ) N3 = 0
    	IF( N3.GT.7 ) N3 = 7
    	IPB(IPL+1) = ESC		!<ESC>LI char-cell-back indices
    	IPB(IPL+2) = 'L'
    	IPB(IPL+3) = 'I'
    	IPL = IPL + 3
    	IPB(IPL+1) = 48 + N1
    	IPB(IPL+2) = 48 + N2
    	IPB(IPL+3) = 48 + N3
    	IPL = IPL + 3
C
C  DUMP THE BUFFER...
C
	CALL IFINIT_DUMP
    	RETURN
    	END

     	SUBROUTINE IFINIT_EXIT
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  MAY-1987
C
C	THIS ROUTINE CLEANS UP GRAPHICS SCREEN
C	AND TERMINATES ALL PLOT SESSIONS.
C
     	INCLUDE 'TEKLIB.CBS'
C
C  CLEAN UP THE SCREEN...
C
     	IF(IDF.GT.0) CLOSE(UNIT=IDF,STATUS='DELETE')	!DELETE DI FILE
     	IF(ITM.EQ.2) THEN
     	    CALL IFGIN_ABLE( 0 )		!DIABLE GIN IF ACTIVE
    	    CALL IFSEG_OPEN( 999999 )		!DELETE ALL GRAPHIC SEGMENTS
    	    CALL IFMAC_MACROS( 0 )		!DELETE ALL DEFINED MACROS
     	    CALL IFINIT_LINE( -24 )		!RESET DIALOGUE AREA LINES
    	    CALL IFINIT_INDEX( 1,4,4 )		!RESET DIALOGUE AREA INDICES
    	    CALL IFINIT_FRESH			!ERASE THE GRAPHIC AREA
     	ENDIF
     	IF(ITM.EQ.3) CALL IFINIT_REGIS		!CLEAR REGIS SCREEN
     	CALL IFANSI_LEDS(0)			!CLEAR ALL ANSI LEDS
     	CALL IFANSI_CLEAR(2)			!CLEAR THE BOTTOM SCREEN
     	CALL IFANSI_VIDEO(47)			!RESET WRITING COLOR
     	CALL IFANSI_WHERE(ITM,IDF)		!GET CURRENT CURSOR POSITION
     	CALL IFANSI_MARGIN(0,0)			!REMOVE SCREEN MARGINS
     	CALL IFANSI_CURSOR(ITM,IDF)		!MOVE TO LAST CURSOR POSITION
     	CLOSE(UNIT=LUN)				!CLOSE TERMINAL GRAPHICS
C
C  ENABLE DCL DETECTION OF CTRL_Y...
C
     	ITM = 2**25
     	CALL LIB$ENABLE_CTRL( %REF(ITM) )
C
C  RESET USER TERMINAL CHARACTERISTICS...
C
     	CALL IFINIT_TERM( 'RESTORE' )
     	RETURN
     	END

     	SUBROUTINE IFINIT_OVER( NS )
C
C	THIS ROUTINE RETURNS THE NUMBER OF PLOTS ON SCREEN
C
     	INCLUDE 'TEKLIB.CBS'
     	NS = NSE
     	RETURN
     	END

     	LOGICAL FUNCTION IFINIT_SAVE()
C
C	THIS ROUTINE SAVES THE CURRENT PLOT SESSION.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( NSE.LT.10 ) THEN
     	    CALL IFSEG_PIVOT( 0.0, 0.0 )
     	    CALL IFSEG_OPEN( NSE+10 )
     	    IFINIT_SAVE = .TRUE.
     	ELSE
     	    CALL IFMISC_OOPS( 23, 0, 0, ' ' )
     	    IFINIT_SAVE = .FALSE.
     	ENDIF
     	RETURN
     	END

    	SUBROUTINE IFINIT_PLOT( XORG, YORG, DNAME )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE INITIALIZES A PLOT SESSION.
C
C	XORG, YORG --- GRAPH ORIGIN IN INCHES.
C	DNAME -------- NAME OF DATA FILE TO BE PLOTTED.
C
    	INCLUDE		'TEKLIB.CBS'
     	CHARACTER	DNAME*(*)
C
C  QUEUE AN ASYNCHRONOUS SYSTEM TRAP (AST) FOR CTRL/C INTERRUPT...
C
     	CALL IFQAST_CTRLC
     	IF( .NOT.IF_DCL_HARDCOPY() )
     +  CALL IFANSI_TEXT('Press CTRL/C to abort...',24,1,1)
C
C  GET DATA FILENAME...
C
     	IF( DNAME.EQ.' ' ) THEN
     	    DTNAME = 'JUNK.DAT'
     	ELSE
     	    IF( DNAME.EQ.'$OVERLAY' ) THEN
     		IF( .NOT.IF_DCL_SKIPDI() .AND. IDF.EQ.0 ) GOTO 222
     		NSE = NSE + 1
     		GOTO 111
     	    ENDIF
     	    DTNAME = DNAME
     	ENDIF
     	IF( IF_DCL_SKIPDI() ) GOTO 111
C
C  OPEN THE DEVICE-INDEPENDENT "DI" FILE FOR HARDCOPY
C
  222	DINAME = DTNAME
     	CALL IFMISC_NAMEXT( DINAME, '.DI' )
     	IF( IDF.GT.0 ) CLOSE(UNIT=IDF, STATUS='DELETE' )
     	IDF = 49
     	OPEN( UNIT=IDF, FILE=DINAME, STATUS='NEW',
     +  FORM='FORMATTED', CARRIAGECONTROL='LIST' )
     	NSE  = 0
     	NPPS = 0
  111	IDW  = 0
C
C  INITIALIZE COMMON GRAPHICS PARAMETERS...
C
     	ILP = 0
     	IFN = 1
     	IFP = 0
     	IFF = 0
     	NEW = 1
     	LTY = 1
     	LWD = 1
     	ANSI = .FALSE.
     	XSCL = 1.0
     	YSCL = 1.0
     	XANG = 0.0
     	YANG = 0.0
     	XCTH = 1.0
     	XSTH = 0.0
     	YCTH = 1.0
     	YSTH = 0.0
     	XORS = 0.0
     	YORS = 0.0
     	FUNI = 410.0
     	IF( ITM.EQ.3 ) FUNI = 72.0
     	IXO  = XORG*FUNI
     	IYO  = YORG*FUNI
     	IXL  = IXO
     	IYL  = IYO
     	IF( NSE.EQ.0 ) THEN
     	    IF( ITM.EQ.2 ) CALL IFINIT_FRAME( XORG, YORG, DTNAME )
     	    IF( ITM.EQ.3 ) CALL IFINIT_REGIS
     	ENDIF
     	CALL IFSTYL(1,1)		!SELECT PLOTTING STYLUS
     	CALL IFINIT_DUMP		!DUMP INIT BUFFER
     	IF( IDF.GT.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) XORG,YORG
     	    IDW = 1			!WRITE "DI" FILE ON
     	ENDIF
 1000	FORMAT('STAR:',2F8.3)
  999	RETURN
    	END

    	SUBROUTINE IFINIT_FRAME( XORG, YORG, FNAME )
C
C  PROGRAMMER: R.S. ZHOU	FEB-1986
C
C	THIS ROUTINE DISPLAYS A FRAMEOWRK ON PLOTTING BACKGROUND.
C
     	CHARACTER FNAME*(*), FKEY*3

     	IF( FNAME.NE.' ' ) THEN
     	    I = INDEX( FNAME, ']' )
     	    IF(I.GT.0) FNAME = FNAME(I+1:)
     	ENDIF
     	CALL IFPLOT_VECT( -XORG, -YORG, -3 )	!REORIGIN TO CORNER
     	CALL IFSEG_OPEN( 999999 ) 		!CLEAR TERMINAL MEMERY
     	CALL IFINIT_FRESH			!CLEAR RASTER SCREEN
     	CALL IFSEG_OPEN( 1 )			!OPEN SEGMENT #1
     	CALL IFSPEN( 7 )
     	CALL IFPLOT_VECT( 0.00, 0.00, 3 )	!OUTLINE THE SCREEN SPACE
     	CALL IFPLOT_VECT( 0.00, 7.64, 2 )
     	CALL IFPLOT_VECT( 9.97, 7.64, 2 )
     	CALL IFPLOT_VECT( 9.97, 0.00, 2 )
     	CALL IFPLOT_VECT( 0.00, 0.00, 2 )
     	CALL IFSPEN( 1 )
     	CALL IFPLOT_VECT( 0.10, 7.35, 3 )
     	CALL IFPLOT_VECT( 9.87, 7.35, 2 )
     	CALL IFTEXT( 0.10,7.43,'FILE:',0.12,0.12,0.0)
     	CALL IFTEXT( 5.00,7.43,'WORKING ORIGINS',0.12,0.12,0.0)
     	CALL IFTEXT( 7.35,7.43,'PEN_CODE:',0.12,0.12,0.0)
     	IF( FNAME.NE.' ' ) THEN
     	    CALL IFSPEN( 3 )
     	    CALL IFTEXT( 0.75,7.43,FNAME,0.12,0.12,0.0)
     	ENDIF
     	CALL IFSPEN( 2 )
     	CALL IFMARK( 4.85,7.48,0.12,0.0,9 )
     	DO I=1, 7
     	   CALL IFSPEN( I )
     	   CALL IFMARK( 8.30+I*0.2, 7.48, 0.12, 0.0, 1 )
     	ENDDO
     	CALL IFSEG_OPEN( 0 )			!CLOSE SEGMENT #1

     	CALL IFPLOT_VECT( XORG, YORG, -3 )	!MOVE TO THE ORIGIN
     	CALL IFSEG_OPEN( 2 )			!OPEN SEGMENT #2
     	CALL IFSPEN( 1 )
     	CALL IFSEG_PIVOT( 0.0, 0.0 )
     	CALL IFMARK( 0.0, 0.0, 0.12, 0.0, 9 )
     	CALL IFSEG_OPEN( 0 )			!CLOSE SEGMENT #2
     	CALL IFSEG_OPEN( 3 )			!OPEN SEGMENT #3
     	CALL IFSPEN( 2 )
     	CALL IFSEG_PIVOT( 0.0, 0.0 )
     	CALL IFMARK( 0.0, 0.0, 0.12, 0.0, 9 )
     	CALL IFSEG_OPEN( 0 )			!CLOSE SEGMENT #3

999	RETURN
    	END

    	SUBROUTINE IFINIT_FRESH
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE ISSUES A SCREEN CLEAR COMMAND TO FRESH THE SCREEN,
C	AS A RESULT, ALL DEFINED GRAPH SEGMENTS ARE REDRAWN.
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( IPL.GT.MBS-2 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC			!<ESC><FF>
    	IPB(IPL+2) = FF
    	IPL = IPL + 2

    	CALL IFINIT_DUMP

    	RETURN
    	END

     	SUBROUTINE IFINIT_REGIS
C
C  THIS ROUTINE CLEARS A REGIS SCREEN.
C
     	INCLUDE   'TEKLIB.CBS'
    	BYTE      REGIS(43)
    	CHARACTER INITR*43
    	EQUIVALENCE (REGIS(1),INITR(1:1))
    	DATA INITR / 'S(E)S(I0N0A)W(VI7A0S0M1N0P1M2)T(I0A0D0S1)@.' /
     	IF( IPL.GT.MBS-43 ) CALL IFINIT_DUMP
    	DO I=1, 43
    	   IPL = IPL + 1
    	   IPB(IPL) = REGIS(I)
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFINIT_DIF( ICODE )
C
C	THIS ROUTINE ENABLES OR DISABLES WRITING OF "DI" FILE.
C
     	INCLUDE 'TEKLIB.CBS'
     	IDW = ICODE
     	IF( IDW.NE.0 ) IDW = 1
     	IF( IDF.EQ.0 ) IDW = 0
     	RETURN
     	END

     	LOGICAL FUNCTION IFINIT_DIFF()
     	INCLUDE 'TEKLIB.CBS'
     	IF( IDF.GT.0 ) THEN
     	    IFINIT_DIFF = .TRUE.
     	ELSE
     	    IFINIT_DIFF = .FALSE.
     	ENDIF
     	RETURN
     	END

    	SUBROUTINE IFINIT_DUMP
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE DUMPS THE GRAPHIC BUFFER.
C
    	INCLUDE 'TEKLIB.CBS'
        BYTE      SCRATCH(NBS)
        CHARACTER TPB*1
        EQUIVALENCE( TPB(1:1), SCRATCH(1) )

     	IF( CTRL_C .OR. ITM.EQ.1 .OR. IPL.LT.5 ) GOTO 999
    	IF( ITM.EQ.2 ) THEN
    	    IPB(IPL+1) = ESC		!<ESC>%!1: ENTER ANSI MODE
    	    IPB(IPL+2) = '%'
    	    IPB(IPL+3) = '!'
    	    IPB(IPL+4) = '1'
    	    IPL = IPL + 4
    	ENDIF
    	IF( ITM.EQ.3 ) THEN
    	    IPB(IPL+1) = ESC		!EXIT GRAPHIC MODE
    	    IPB(IPL+2) = '\'
    	    IPL = IPL + 2
    	ENDIF
        DO I=1, IPL
           SCRATCH(I) = IPB(I)
        ENDDO
    	WRITE(LUN,1) TPB(1:IPL)
  1	FORMAT(A,$)
 999	IPL = IPK
     	RETURN
    	END

     	SUBROUTINE IFINIT_PLOT_END
C
C	COUNTER ROUTINE TO IFINIT_PLOT TO TERMINATE A PLOT SESSION.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C ) THEN
     	    IF( ITM.EQ.2 ) WRITE(LUN,1000) ESC	!RESET TERMINAL TO ANSI
1000	    FORMAT(A1,'%!1',$)
     	    IF( ITM.EQ.3 ) WRITE(LUN,1001) ESC	!RESET TERMINAL TO ANSI
1001	    FORMAT(A1,'\',$)
     	    IDW = 0
     	    IF( IDF.GT.0 ) THEN
     		CLOSE(UNIT=IDF, STATUS='DELETE' )
     		IDF = 0
     		NSE = 0
     	    ENDIF
     	    CTRL_C = .FALSE.
     	ELSE
     	    CALL IFINIT_DUMP			!DUMP THE FINAL BUFFER
     	    CALL SYS$DASSGN( %VAL(NCC) )	!DEASSIGN THE AST CHANNEL
     	    IF( ITM.NE.1 ) CALL IFANSI_CLEAR(6)
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE IFINIT_FKEYS( F1,F2,F3,F4,F5,F6,F7,F8 )
C
C	THIS ROUTINE DISPLAYS FUNCTION KEY DEFINITIONS.
C
     	INCLUDE  'TEKLIB.CBS'
     	CHARACTER F1*(*), F2*(*), F3*(*), F4*(*)
     	CHARACTER F5*(*), F6*(*), F7*(*), F8*(*)
     	CHARACTER KEYF*3, FKEY(8)*8

     	IF( ITM.NE.2 ) RETURN
C
C  RESET ORIGIN TO (0,0)...
C
     	IXOS = IXO
     	IYOS = IYO
     	XORG = XORS
     	YORG = YORS
     	XSCF = XSCL
     	YSCF = YSCL
     	XSCL = 1.0
     	YSCL = 1.0
     	ANGX = XANG
     	ANGY = YANG
     	CALL IFROTA( 0.0, 0.0 )
     	IXO  = 0
     	IYO  = 0
     	XORS = 0.0
     	YORS = 0.0
     	IWD  = IDW
     	IDW  = 0
C
C  DISPLAY THE FKEYS...
C
     	FKEY(1) = F1
     	FKEY(2) = F2
     	FKEY(3) = F3
     	FKEY(4) = F4
     	FKEY(5) = F5
     	FKEY(6) = F6
     	FKEY(7) = F7
     	FKEY(8) = F8
     	CALL IFSEG_OPEN(-4 )
     	CALL IFSEG_OPEN( 4 )
     	CALL IFSPEN(3)
     	KEYF = 'F :'
     	DO  IKEY=1, 8
     	    WRITE(KEYF(2:2),111) IKEY
C     	    ENCODE( 1, 111, KEYF(2:2) ) IKEY
  111	    FORMAT(I1)
     	    CALL IFTEXT( 1.25*IKEY-1.15,7.2, KEYF, 0.1,0.1,0 )
     	    IF(FKEY(IKEY).NE.' ') CALL IFTEXT(1.25*IKEY-.8,7.2,
     +      FKEY(IKEY),0.1,0.1,0)
     	ENDDO
     	CALL IFSEG_OPEN( 0 )
     	CALL IFINIT_DUMP
C
C  RESTORE ORIGIN...
C
     	IXO = IXOS
     	IYO = IYOS
     	XORS= XORG
     	YORS= YORG
     	XSCL= XSCF
     	YSCL= YSCF
     	CALL IFROTA( ANGX, ANGY )
     	IDW = IWD

     	RETURN
     	END

        SUBROUTINE IFINIT_TERM( MRBILL )
C
C	PROGRAMMER: JAMES WALKER, ALFRED, NY
C
C	MODIFIED BY R.S. ZHOU, BOSTON COLLEGE, MA
C
C       See chapeter 8 of the "I/O Users Reference Manual: Part I"
C
C       Misfeatures:
C       ------------
C       You are protected for accidentally setting parity.
C       You must set ALTPAR for it to pay attention to PARITY and ODD
C       You must set ALTDISPAR for DISPARERR
C       You are also protected from setting Page length, Page width,
C       terminal type and terminal class.
C
C       You can work around misfeatures by doing "SAVE", tweaking bits
C       in SLUGGO, then doing "RESTORE".
C
C       For modem signals you must use IO$_SENSEMODE+IO$M_RD_MODEM
C
C       Format of CHARBUF & SLUGGO:
C               BYTE            device class
C               BYTE            device type
C               INTEGER*2       page width
C               INTEGER*3       basic characteristics ($TTDEF)
C               BYTE            page length
C               INTEGER*4       extended characteristics ($TT2DEF)
C
        IMPLICIT INTEGER*4 (A-Z)
        CHARACTER*(*) MRBILL    ! Command
        INTEGER*4 SLUGGO(3)     ! Buffer saving characteristics
C
        INTEGER*4 STATUS, IOSB(2), CHARBUF(3)
        INTEGER*2 TERM_CHAN
        DATA TERM_CHAN/0/
        INCLUDE '($IODEF)'
        INCLUDE '($TTDEF)'
        INCLUDE '($TT2DEF)'
        SAVE TERM_CHAN, SLUGGO
C
C Assign channel to terminal if we haven't already done so.
C
        IF( TERM_CHAN .EQ. 0 ) THEN
            STATUS = SYS$ASSIGN ( 'SYS$INPUT', TERM_CHAN, ,)
            IF (.NOT. STATUS) CALL LIB$SIGNAL ( %VAL(STATUS) )
        ENDIF

        IF( MRBILL .EQ. 'RESTORE' ) THEN
            CHARBUF(1) = SLUGGO(1)
            CHARBUF(2) = SLUGGO(2)
            CHARBUF(3) = SLUGGO(3)
            GOTO 111
        ENDIF
C
C Get current characteristics.
C
        STATUS = SYS$QIOW ( , %VAL(TERM_CHAN), %VAL(IO$_SENSEMODE),
     +                        IOSB, , , CHARBUF, %VAL(12), , , , )
        IF (.NOT. STATUS) CALL LIB$SIGNAL ( %VAL(STATUS) )
        IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C Save current characteristics.
C
        SLUGGO(1) = CHARBUF(1)
        SLUGGO(2) = CHARBUF(2)
        SLUGGO(3) = CHARBUF(3)
C
C Set the desired characteristics.
C
        CHARBUF(2) = IBCLR( CHARBUF(2), TT$V_ESCAPE )
        CHARBUF(2) = IBCLR( CHARBUF(2), TT$V_WRAP   )
        CHARBUF(3) = IBSET( CHARBUF(3), TT2$V_INSERT)
  111   STATUS = SYS$QIOW ( , %VAL(TERM_CHAN), %VAL(IO$_SETMODE),
     +                        IOSB, , , CHARBUF, %VAL(12), , , ,)
        IF (.NOT. STATUS) CALL LIB$SIGNAL ( %VAL(STATUS) )
        IF (.NOT. IOSB(1)) CALL LIB$SIGNAL ( %VAL(IOSB(1)) )
C
C Deassign the input channel.
C
        IF( MRBILL.EQ.'RESTORE' ) CALL SYS$DASSGN( %VAL(TERM_CHAN) )
        RETURN
        END

     	SUBROUTINE IFLINE( ISY, SIZ, ISH, NPT, X, Y )
C
C  PROGRAMMER: RONG-SHENG ZHOU
C	       ALFRED UNIVERSITY	JULY-1985
C
C	THIS ROUTINE IMPLEMENTS A COMPREHENSIVE POLYLINE FUNCTION.
C
C       ISY --- AN INTEGER DESIGNATING THE SYMBOL TO BE USED.
C		IF ISY<0, NO LINE CONNECTIONS BUT SYMBOLS.
C
C	SIZ --- SIZE OF SYMBOLS IF AT ALL.
C
C	ISH --- PLOTTING MODE:
C		ISH = 0: NORMAL LINE &/ SYMBOL PLOT.
C		ISH = 1: AREA-FILL TO THE HORIZONTAL REFERENCE LINE.
C			 FILL-PATTERN = ISY
C		ISH =-1: AREA-FILL FROM THE 1ST POINT TO THE LAST POINT.
C			 FILL-PATTERN = ISY AND SYMBOLS ARE SKIPPED.
C		ISH = 2: STICK PLOT IN ADDITION.
C		ISH = 3: BAR PLOT IN ADDITION:
C			 BAR-WIDTH=SIZ; BAR-PATTERN=ISY; SYMBOLS ARE SKIPPED.
C
C       NPT --- NUMBER OF VERTICES IN THE ARRAY.
C		IF NPT<0, A SPLINE-CURVE IS GENERATED.
C
C       X,Y --- ARRAY OF SCALED ORDINATE AND ABCISSA VALUES.
C	X(NPT+1),Y(NPT+1) --- MINIMUM SCALED VALUES IN THE SET.
C	X(NPT+2),Y(NPT+2) --- INCREMENTAL VALUES PER INCH.
C	Y(NPT+3) ------------ HORIZONTAL REFERENCE LINE FOR STICK/BAR/AREA-FILL
C
	DIMENSION X(1), Y(1)
     	LOGICAL ANSI
C
C  QUIT ON CTRL_C...
C
     	IF( IFCTRL_C() ) RETURN
C
C  INITIALIZE...
C
     	CALL IFANSI_FLAG( ANSI )
     	LSY  = ISY
    	ISYM = IABS(LSY)
    	SIZE = ABS(SIZ)
    	IF( SIZE.EQ.0.0 ) SIZE = 0.05
    	ISHD = IABS(ISH)
     	NNN  = NPT
    	NN   = IABS(NNN)
        IF( NN.LT.3 ) NNN = NN
    	XMIN = X(NN+1)
    	YMIN = Y(NN+1)
    	DX   = X(NN+2)
    	DY   = Y(NN+2)
     	RL   = (Y(NN+3)-YMIN)/DY
    	X0   = (X(1)-XMIN)/DX
    	Y0   = (Y(1)-YMIN)/DY
     	XO   = X0
     	YO   = Y0
C
C  TAKE CARE OF THE FIRST VERTEX...
C
     	IF( ISHD.EQ.0 .OR. ISHD.EQ.2 ) THEN
    	    IF( ISYM.EQ.0 ) THEN
     		CALL IFPLOT( X0, Y0, 3 )
     	    ELSE
     		CALL IFMARK( X0, Y0, SIZE, 0.0, ISYM )
     	    ENDIF
    	    IF( ISHD.EQ.2 ) THEN
     		CALL IFPLOT( X0, RL, 2 )
     		CALL IFPLOT( X0, Y0, 3 )
     	    ENDIF
     	ENDIF
     	IF( ISHD.EQ.3 ) THEN
     	    JFP = ISYM
     	    IF( JFP.GT.0 ) CALL IFFILL( JFP )
    	    CALL IFBARS( X0,0.5*(Y0+RL),SIZE,Y0-RL,0.0,0.0 )
     	    IF( JFP.GT.0 ) CALL IFFILL( 0 )
    	    CALL IFPLOT( X0, Y0, 3 )
     	    ISYM = 0
    	ENDIF
     	IF( ISHD.EQ.1 ) THEN
     	    JFP = LSY
     	    IF( JFP.EQ.0 ) JFP = 1
     	    CALL IFFILL( JFP )
     	    IF( ISH.LT.0 ) THEN
     		CALL IFPLOT( X0, Y0, 3 )
     	    ELSE
     		CALL IFPLOT( X0, RL, 3 )
     		CALL IFPLOT( X0, Y0, 2 )
     	    ENDIF
     	    LSY = 0
     	    ISYM= 0
     	ENDIF
     	IF( ANSI ) CALL IFANSI_DRAW( ISYM )

	IF( NNN.LT.0 ) THEN
    	    U  = (X(2)-X(1))/DX
    	    V  = (Y(2)-Y(1))/DY
    	    U1 = (X(NN)-X(NN-1))/DX
    	    V1 = (Y(NN)-Y(NN-1))/DY
    	    SU = U
    	    SV = V
    	    IF( X(1).NE.X(NN) .OR. Y(1).NE.Y(NN) ) THEN
     	        SU = (X(NN-1)-X(NN-2))/DX
    	        SV = (Y(NN-1)-Y(NN-2))/DY
    	        CALL IFLINE_REFLX(U1,V1,SU,SV)
    	        U1 = (X(3)-X(2))/DX
    	        V1 = (Y(3)-Y(2))/DY
    	        CALL IFLINE_REFLX(U,V,U1,V1)
     	    ENDIF
     	ENDIF
C
C  TAKE CARE OF THE REST OF VERTICES...
C
     	XA = 0.0
     	YA = 0.0
     	DIST = 0.0
     	DO I=2, NN

     	   IF( IFCTRL_C() ) RETURN
    	   XN = (X(I)-XMIN)/DX
    	   YN = (Y(I)-YMIN)/DY
     	   IF( LSY.LT.0 ) GOTO 10

     	   IF( ISYM.GT.0 ) THEN
     	       DIST = SQRT( (XN-X0)**2 + (YN-Y0)**2 )
     	       IF( DIST.LT.SIZE+0.01 ) GOTO 10
     	       DIST = 0.5*SIZE/(DIST-0.5*SIZE)
     	       XA = (X0+DIST*XN)/(1.0+DIST)
     	       YA = (Y0+DIST*YN)/(1.0+DIST)
     	       CALL IFPLOT( XA, YA, 3 )
     	       XA = XA - X0
     	       YA = YA - Y0
     	       DIST = 0.5*SIZE
     	   ENDIF

     	   IF( NNN.GT.0 ) THEN
     	       CALL IFPLOT( XN-XA, YN-YA, 2 )
     	   ELSE
     	       IF( I.LT.NN ) THEN
     		   U2 = (X(I+1)-XMIN)/DX - XN
     		   V2 = (Y(I+1)-YMIN)/DY - YN
     	       ELSE
     		   U2 = SU
     		   V2 = SV
     	       ENDIF
     	       J = IFLINE_FIT4( X0,Y0,XN,YN,U1,V1,U2,V2,DIST )
     	       IF( J.NE.0 ) CALL IFPLOT( XN-XA, YN-YA, 2 )
    	       U1 = U
    	       V1 = V
    	       U  = U2
    	       V  = V2
     	   ENDIF

  10	   IF( ISYM.GT.0 ) CALL IFMARK( XN, YN, SIZE, 0.0, ISYM )
  	   IF( ISHD.EQ.2 ) THEN
     	       CALL IFPLOT( XN, RL, 2 )
     	       CALL IFPLOT( XN, YN, 3 )
     	   ENDIF
    	   IF( ISHD.EQ.3 ) THEN
     	       IF( JFP.GT.0 ) CALL IFFILL( JFP )
    	       CALL IFBARS( XN,0.5*(YN+RL),SIZE,YN-RL,0.,0.0 )
     	       IF( JFP.GT.0 ) CALL IFFILL(  0  )
    	       CALL IFPLOT( XN, YN, 3 )
    	   ENDIF
     	   IF( ANSI ) CALL IFANSI_DRAW( ISYM )
    	   X0 = XN
    	   Y0 = YN
     	ENDDO

999	IF( ISHD.EQ.1 ) THEN
     	    IF( ISH.GT.0 ) THEN
     		CALL IFPLOT( XN, RL, 2 )
     		CALL IFPLOT( XO, RL, 2 )
     	    ELSE
     		CALL IFPLOT( XO, YO, 2 )
     	    ENDIF
     	    CALL IFFILL( 0 )
     	ENDIF
     	RETURN
	END

     	FUNCTION IFLINE_FIT4(PX1,PY1,PX2,PY2,VECX1,VECY1,
     +                       VECX3,VECY3,SIZ)
     	WW=SIZ
	X1=PX1
	Y1=PY1
     	X2=PX2
     	Y2=PY2
    	VX3=PX2-X1
	VY3=PY2-Y1
	VX2=VECX1
	VY2=VECY1
	D2=VX2*VX2+VY2*VY2
	T=1.
	GO TO 7

  6	T=0.
	VX2=VX3
	VY2=VY3
	VX3=VECX3
	VY3=VECY3
	D2=D3
	UX1=UX2
	UY1=UY2

  7	D3=VX3*VX3+VY3*VY3
	UX2=D2*VX3+D3*VX2
	UY2=D2*VY3+D3*VY2
	D = UX2*UX2+UY2*UY2
     	IF( D.EQ.0.0 ) THEN
     	    IFLINE_FIT4 = 1
     	    RETURN
     	ENDIF
	DV=1.0/SQRT(D)
	UX2=DV*UX2
	UY2=DV*UY2
	IF(T)6,8,6
 
  8	D=ABS(UX1*VX2+UY1*VY2)
	D1=D
	UUX1=D*UX1
	UUY1=D*UY1
	D=ABS(UX2*VX2+UY2*VY2)
	UUX2=D*UX2
	UUY2=D*UY2
	D=D+D1
	AX=UUX2+UUX1-VX2-VX2
	BX=VX2-UUX1-AX
	AY=UUY2+UUY1-VY2-VY2
	BY=VY2-UUY1-AY
	N=10.*D+1.
	D=1.0/FLOAT(N)

     	IBYP = 0

	DO 9 I=1, N

	T = T+D
	X = ((AX*T+BX)*T+UUX1)*T+X1
	Y = ((AY*T+BY)*T+UUY1)*T+Y1
     	IF( WW.EQ.0.0 ) GOTO 99
C
C  BYPASSING SYMBOLS...
C
     	DIST = SQRT( (X-X1)**2 + (Y-Y1)**2 )
     	IF( DIST.LT.WW ) GOTO 9
     	IF( IBYP.EQ.0 ) THEN
     	    IBYP = 1
     	    IF( DIST.GT.WW+0.01 ) THEN
     	    	DIST = WW/(DIST-WW)
     	    	X = (X1+DIST*X)/(1.0+DIST)
     	    	Y = (Y1+DIST*Y)/(1.0+DIST)
     		CALL IFPLOT( X,Y,3 )
     	    ENDIF
     	ENDIF
     	DIST = SQRT( (X-X2)**2 + (Y-Y2)**2 )
     	IF( DIST.GT.WW ) GOTO 99
     	IBYP = 2
     	IF( DIST.LT.WW-0.005 ) THEN
     	    DIST = SQRT( (XA-X2)**2 + (YA-Y2)**2 )
     	    DIST = WW/(DIST-WW)
     	    X = (X2+DIST*XA)/(1.0+DIST)
     	    Y = (Y2+DIST*YA)/(1.0+DIST)
     	ENDIF

  99	CALL IFPLOT( X,Y,2 )
     	IF( IBYP.EQ.2 ) GOTO 999
     	XA = X
     	YA = Y

  9	CONTINUE
 999	IFLINE_FIT4 = 0
     	RETURN
	END

     	SUBROUTINE IFLINE_REFLX(VX1,VY1,VX2,VY2)

	PS=VY1*VY1
	DS=VX1*VX1
	SS=DS+PS
    	IF( SS.NE.0.0 ) THEN
	    DS=DS-PS
	    PS=2.0*VX1*VY1
	    TEMP=(PS*VY2+VX2*DS)/SS
	    VY2=(PS*VX2-VY2*DS)/SS
	    VX2=TEMP
     	ENDIF
	RETURN
	END

     	SUBROUTINE IFMAC_MACROS( ICODE )
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE DEFINES THE FOLLOWING KEY-EXPANDED MACROS
C	ON A TEK-4100 SERIES TERMINAL( UNSHIFT ).
C
C	ICODE = 0: DELETE ALL VOLATILE MACROS.
C	ICODE = 1: DEFINE F1-F8 AND KEYPAD NUMBERS FOR DIALOGUE.
C	ICODE = 2: DEFINE F1-F8, <DEL>, <ENTER> FOR GIN.
C
     	INCLUDE		'TEKLIB.CBS'
     	DIMENSION	MACS(3)

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  CALL IFMAC_DEFINE TO DEFINE THE MACROS...
C
    	ICD = IABS(ICODE)
C
C  DELETE ALL VOLATILE MACROS FIRST...
C
     	CALL IFMAC_DEFINE( -1, 0, 0 )
    	IF( ICD.EQ.0 ) GOTO 999
C
C  DEFINE MACROS...
C
     	IF( ICD.EQ.1 ) THEN
C
C		10 NUMBER KEYS ON KEYPAD AS
C	   	0,1,2,3,4,5,6,7,8,9 PLUS <CR>
C
C		F1  ====  F1<CR>
C		F2  ====  F2<CR>
C		F3  ====  F3<CR>
C		F4  ====  F4<CR>
C		F5  ====  F5<CR>
C		F6  ====  F6<CR>
C		F7  ====  F7<CR>
C		F8  ====  F8<CR>
C
     	    MACS(1) = 70
     	    MACS(3) = 13
     	    DO  I= 1, 8
     		MACS(2) = 48+I
     		CALL IFMAC_DEFINE( 127+I, 3, MACS(1) )
    	    ENDDO
     	    MACS(2) = 13
     	    DO  I= 0, 9
     		MACS(1) = 48+I
     		CALL IFMAC_DEFINE( -55-I, 2, MACS(1) )
     	    ENDDO
     	ENDIF

     	IF( ICD.EQ.2 ) THEN
C
C		F1  ====  86 (ASCII CODE) --- V
C		F2  ====  88 (ASCII CODE) --- X
C		F3  ====  82 (ASCII CODE) --- R
C		F4  ====  26 (ASCII CODE) --- ^Z
C		F5  ====  72 (ASCII CODE) --- H
C		F6  ====  73 (ASCII CODE) --- I
C		F7  ====  74 (ASCII CODE) --- J
C		F8  ====  75 (ASCII CODE) --- K
C	    <ENTER> ====  84 (ASCII CODE) --- T
C	      <DEL> ====  92 (ASCII CODE) --- \
C      <MOUSE_LEFT_NOSHI>  ==== 32 (ASCII CODE) --- SPACEBAR
C      <MOUSE_LEFT_SHIFT>  ==== 77 (ASCII CODE) --- M
C      <MOUSE_MIDLE_NOSHI> ==== 84 (ASCII CODE) --- T
C      <MOUSE_MIDLE_SHIFT> ==== 84 (ASCII CODE) --- T
C      <MOUSE_RIGHT_NOSHI> ==== 46 (ASCII CODE) --- DOT
C      <MOUSE_RIGHT_SHIFT> ==== 44 (ASCII CODE) --- COMMA
C
     	    CALL IFMAC_DEFINE( 128, 1, 86 )
     	    CALL IFMAC_DEFINE( 129, 1, 88 )
     	    CALL IFMAC_DEFINE( 130, 1, 82 )
     	    CALL IFMAC_DEFINE( 131, 1, 26 )
     	    CALL IFMAC_DEFINE( 132, 1, 72 )
     	    CALL IFMAC_DEFINE( 133, 1, 73 )
     	    CALL IFMAC_DEFINE( 134, 1, 74 )
     	    CALL IFMAC_DEFINE( 135, 1, 75 )
     	    CALL IFMAC_DEFINE( -68, 1, 84 )
     	    CALL IFMAC_DEFINE( 127, 1, 92 )
     	    CALL IFMAC_DEFINE(-155, 1, 32 )
     	    CALL IFMAC_DEFINE(-161, 1, 77 )
     	    CALL IFMAC_DEFINE(-157, 1, 84 )
     	    CALL IFMAC_DEFINE(-163, 1, 84 )
     	    CALL IFMAC_DEFINE(-159, 1, 46 )
     	    CALL IFMAC_DEFINE(-165, 1, 44 )
     	ENDIF

999	CALL IFINIT_DUMP

     	RETURN
    	END

     	SUBROUTINE IFMAC_DEFINE( NUMBER, LENGTH, STRING )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE DEFINES A VOLATILE MACRO ON A TEK-4100 TERMINAL.
C
C	*** READ TEK-4100 MANUAL FOR MACRO DEFINITION ***
C
C	NUMBER: MACRO NUMBER FOR A NON-KEY MACRO.
C		ASCII DECIMAL EQUIVALENCE FOR A KEY MACRO.
C		VALID RANGE OF "NUMBER": -150 TO -2, 0 TO 32767.
C		NUMBER = -1: DELETE ALL DEFINED MACROS.
C		FORMAT: INTEGER
C	LENGTH: NUMBER OF CHARACTERS IN THE MACRO.
C		LENGTH = 0: DELETE THE "NUMBER" MACRO.
C		FORMAT: INTEGER
C	STRING: MACRO CONTENTS IN ASCII	DECIMAL EQUIVALENCES.
C		FORMAT: INTEGER ARRAY
C
C	TEK-4100 COMMAND: <ESC>KD macro-number macro-contents
C
     	INCLUDE 'TEKLIB.CBS'

     	INTEGER STRING(1)

     	ICD = NUMBER
     	LEN = IABS(LENGTH)
C
C  IF THE BUFFER IS FULL, DUMP IT...
C
     	IF( IPL.GT.NBS-LEN*3-IPK-9 ) CALL IFINIT_DUMP
C
C  LOAD <ESC>KD...
C
    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'K'
    	IPB(IPL+3) = 'D'
    	IPL = IPL + 3
C
C  PACK THE MACRO NUMBER...
C
    	CALL IFPACK_TEKINT( ICD )
     	IF( ICD.EQ.-1 ) GOTO 999
C
C  PACK THE STRING LENGTH...
C
     	CALL IFPACK_TEKINT( LEN )
     	IF( LEN.EQ.0 ) GOTO 999
C
C  PACK THE MACRO CONTENTS...
C
     	DO I=1, LEN
     	   IKEY = STRING(I)
     	   CALL IFPACK_TEKINT( IKEY )
     	ENDDO

999	RETURN
     	END

    	SUBROUTINE IFMAC_EXPAND( NUMBER )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE EXPANDS A MACRO OF NUMBER "NUMBER",
C	WHICH COULD BE A KEY-MACRO OR NON-KEY-MACRO.
C	VALID RANGE OF "NUMBER": -150 TO -2, 0 TO 32767.
C
    	INCLUDE 'TEKLIB.CBS'

     	MNUM = NUMBER
     	IF( MNUM.EQ.-1 ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-6 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC		!<ESC>KX
    	IPB(IPL+2) = 'K'
    	IPB(IPL+3) = 'X'
    	IPL = IPL + 3
     	CALL IFPACK_TEKINT( MNUM )
    	CALL IFINIT_DUMP

    	RETURN
    	END

    	SUBROUTINE IFMAC_KEYEXP( ICODE )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINE ENABLES( ICODE=1 ) OR DISABLES( ICODE=0 )
C	KEY EXPANSION OF MACROS.
C
    	INCLUDE 'TEKLIB.CBS'
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-4 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC		!<ESC>KW
    	IPB(IPL+2) = 'K'
    	IPB(IPL+3) = 'W'
    	IPL = IPL + 4
    	IF( ICODE.EQ.0 ) IPB(IPL) = '0'
    	IF( ICODE.EQ.1 ) IPB(IPL) = '1'
    	CALL IFINIT_DUMP

    	RETURN
    	END

    	SUBROUTINE IFMARK( XPOS, YPOS, SIZE, ANGLE, ICODE )
C
C   PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS MARKER SYMBOLS USING "IFPLOT" COMMANDS.
C
C	ICODE --- POINTER TO THE FOLLOWING SYMBOL TABLE:
C
C		ICODE = 1 : SQUARE
C		ICODE = 2 : SOLID SQUARE
C		ICODE = 3 : HEXAGON
C		ICODE = 4 : SOLID HEXAGON
C		ICODE = 5 : TRIANGLE
C		ICODE = 6 : SOLID TRIANGLE
C		ICODE = 7 : DIAMOND
C		ICODE = 8 : SOLID DIAMOND
C		ICODE = 9 : PLUS
C		ICODE =10 : CROSS
C		ICODE =11 : STAR
C		ICODE =12 : DOUBLE TRIANGLES
C		ICODE =13 : CIRCLE
C		ICODE =14 : CIRCLE + CROSS
C		ICODE =15 : FULL MOON
C		ICODE =16 : RIGHT HALF MOON
C		ICODE =17 : LEFT HALF MOON
C		ICODE =18 : TOP HALF MOON
C		ICODE =19 : BOTTOM HALF MOON
C
C	SIZE --- DIAMETER OF SYMBOL IN INCHES.
C	XPOS --- X-COORDINATE OF SYMBOL CENTER.
C	YPOS --- X-COORDINATE OF SYMBOL CENTER.
C	ANGLE--- ROTATION ANGLE IN DEGREES.
C
     	INCLUDE 'TEKLIB.CBS'
C
C  SUPRESS WRITING OF "DI" FILE BY THE FOLLOWING SUBROUTINES...
C
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 999
     	IDW = 0
     	RAD = 0.5*ABS(SIZE)
     	IF( RAD.LT.0.01 ) RAD = 0.01
C
C  REORIGIN TO (XPOS,YPOS) ...
C
     	CALL IFPLOT( XPOS, YPOS, -3 )
C
C  SET THE SYMBOL ROTATION IF AT ALL...
C
    	IF( ANGLE.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANGLE+XANG, ANGLE+YANG )
     	ENDIF
     	IF( XSCL.NE.YSCL ) THEN
     	    XSCF = XSCL
     	    YSCF = YSCL
     	    CALL IFSCAL( XSCL, XSCL )
     	ENDIF
     	LTYOLD = LTY
     	IF( LTY.GT.1 ) CALL IFSTYL(1,0)
    	ICD = IABS(ICODE)
     	IF( ICD.EQ.1 ) THEN			!SQUARE
     	    CALL IFMARK_SQUARE( 0.9*RAD )
     	ELSE IF( ICD.EQ.2 ) THEN		!SOLID SQUARE
     	    CALL IFMARK_SSQUARE( 0.9*RAD )
     	ELSE IF( ICD.EQ.3 ) THEN		!HEXAGON
     	    CALL IFMARK_HEXAGON( RAD )
     	ELSE IF( ICD.EQ.4 ) THEN
     	    CALL IFMARK_SHEXAGON( RAD )		!SOLID HEXAGON
     	ELSE IF( ICD.EQ.5 ) THEN
     	    CALL IFMARK_TRIANGLE( 1.2*RAD )	!TRIANGLE
     	ELSE IF( ICD.EQ.6 ) THEN
     	    CALL IFMARK_STRIANGLE( 1.2*RAD )	!SOLID TRIANGLE
     	ELSE IF( ICD.EQ.7 ) THEN
     	    CALL IFMARK_DIAMOND( 1.2*RAD )	!DIAMOND
     	ELSE IF( ICD.EQ.8 ) THEN
     	    CALL IFMARK_SDIAMOND( 1.2*RAD )	!SOLID DIAMOND
     	ELSE IF( ICD.EQ.9 ) THEN
     	    CALL IFMARK_PLUS( RAD )		!PLUS SIGN
     	ELSE IF( ICD.EQ.10 ) THEN
     	    CALL IFMARK_CROSS( 0.85*RAD )	!CROSS
     	ELSE IF( ICD.EQ.11 ) THEN
     	    CALL IFMARK_CROSS( 0.85*RAD )	!CROSS
     	    CALL IFMARK_PLUS( RAD )		!PLUS SIGN
     	ELSE IF( ICD.EQ.12 ) THEN
     	    CALL IFMARK_DTRIANGLE( RAD )	!DOUBLE TRIANGLE
     	ELSE IF( ICD.EQ.13 .OR. ICD.EQ.14 .OR. ICD.EQ.15 ) THEN
     	    IF( ICD.EQ.15 ) CALL IFFILL(1)
     	    CALL IFMARK_CIRCLE( RAD )		!CIRCLE
     	    IF( ICD.EQ.14 ) CALL IFMARK_PLUS(RAD)
     	    IF( ICD.EQ.15 ) CALL IFFILL(0)
     	ELSE IF( ICD.EQ.16 ) THEN
     	    CALL IFMARK_RMOON( RAD )		!RIGHT HALF MOON
     	ELSE IF( ICD.EQ.17 ) THEN
     	    CALL IFMARK_LMOON( RAD )		!LEFT HALF MOON
     	ELSE IF( ICD.EQ.18 ) THEN
     	    CALL IFMARK_TMOON( RAD )		!TOP HALF MOON
     	ELSE IF( ICD.EQ.19 ) THEN
     	    CALL IFMARK_BMOON( RAD )		!BOTTOM HALF MOON
     	ENDIF
C
C  RESTORE ...
C
     	IF( LTYOLD.GT.1 ) CALL IFSTYL(LTYOLD,0)
     	CALL IFPLOT( 0.0, 0.0, 3 )
     	IF( XSCF.NE.YSCF ) CALL IFSCAL( XSCF, YSCF )
    	IF( ANGLE.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XPOS, -YPOS, -9 )

999	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) ICODE, SIZE, XPOS, YPOS, ANGLE
     	ENDIF
1000	FORMAT('MARK:',I3,4F8.3)
     	IDW = IWD
     	RETURN
     	END

     	SUBROUTINE IFMARK_SQUARE( SIZE )
     	RAD = SIZE
     	CALL IFPLOT(  0.0,  RAD, 2 )
    	CALL IFPLOT( -RAD,  RAD, 2 )
    	CALL IFPLOT( -RAD, -RAD, 2 )
    	CALL IFPLOT(  RAD, -RAD, 2 )
    	CALL IFPLOT(  RAD,  RAD, 2 )
     	CALL IFPLOT(  0.0,  RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SSQUARE( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
    	CALL IFPLOT( -RAD,  RAD, 3 )
    	CALL IFPLOT( -RAD, -RAD, 2 )
    	CALL IFPLOT(  RAD, -RAD, 2 )
    	CALL IFPLOT(  RAD,  RAD, 2 )
     	CALL IFPLOT( -RAD,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_HEXAGON( SIZE )
     	RAD = SIZE
     	ADD = 0.866*RAD
     	DDA = 0.500*RAD
    	CALL IFPLOT(  0.0,  RAD, 2 )
    	CALL IFPLOT( -ADD,  DDA, 2 )
    	CALL IFPLOT( -ADD, -DDA, 2 )
    	CALL IFPLOT(  0.0, -RAD, 2 )
    	CALL IFPLOT(  ADD, -DDA, 2 )
    	CALL IFPLOT(  ADD,  DDA, 2 )
     	CALL IFPLOT(  0.0,  RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SHEXAGON( SIZE )
     	RAD = SIZE
     	ADD = 0.866*RAD
     	DDA = 0.500*RAD
     	CALL IFFILL(1)
    	CALL IFPLOT(  0.0,  RAD, 3 )
    	CALL IFPLOT( -ADD,  DDA, 2 )
    	CALL IFPLOT( -ADD, -DDA, 2 )
    	CALL IFPLOT(  0.0, -RAD, 2 )
    	CALL IFPLOT(  ADD, -DDA, 2 )
    	CALL IFPLOT(  ADD,  DDA, 2 )
     	CALL IFPLOT(  0.0,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_TRIANGLE( SIZE )
     	RAD = SIZE
     	ADD = 0.500*RAD
     	DDA = 0.866*RAD
     	CALL IFPLOT(  0.0,  RAD, 2 )
    	CALL IFPLOT( -DDA, -ADD, 2 )
    	CALL IFPLOT(  DDA, -ADD, 2 )
    	CALL IFPLOT(  0.0,  RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_STRIANGLE( SIZE )
     	RAD = SIZE
     	ADD = 0.500*RAD
     	DDA = 0.866*RAD
     	CALL IFFILL(1)
     	CALL IFPLOT(  0.0,  RAD, 3 )
    	CALL IFPLOT( -DDA, -ADD, 2 )
    	CALL IFPLOT(  DDA, -ADD, 2 )
    	CALL IFPLOT(  0.0,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_DIAMOND( SIZE )
     	RAD = SIZE
     	CALL IFPLOT(  0.0,  RAD, 2 )
    	CALL IFPLOT( -RAD,  0.0, 2 )
    	CALL IFPLOT(  0.0, -RAD, 2 )
    	CALL IFPLOT(  RAD,  0.0, 2 )
    	CALL IFPLOT( 0.0, RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SDIAMOND( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFPLOT(  0.0,  RAD, 3 )
    	CALL IFPLOT( -RAD,  0.0, 2 )
    	CALL IFPLOT(  0.0, -RAD, 2 )
    	CALL IFPLOT(  RAD,  0.0, 2 )
    	CALL IFPLOT(  0.0,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_PLUS( SIZE )
     	RAD = SIZE
     	CALL IFPLOT(  0.0,  RAD, 3 )
    	CALL IFPLOT(  0.0, -RAD, 2 )
    	CALL IFPLOT( -RAD,  0.0, 3 )
    	CALL IFPLOT(  RAD,  0.0, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_CROSS( SIZE )
     	RAD = SIZE
     	CALL IFPLOT( -RAD, -RAD, 3 )
    	CALL IFPLOT(  RAD,  RAD, 2 )
    	CALL IFPLOT( -RAD,  RAD, 3 )
    	CALL IFPLOT(  RAD, -RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_DTRIANGLE( SIZE )
     	RAD = SIZE
     	ADD = 0.25*RAD
    	DDA = -RAD + ADD
    	DDD =  RAD + ADD
    	CALL IFPLOT(  0.0, DDD, 3 )
    	CALL IFPLOT( -RAD, DDA, 2 )
    	CALL IFPLOT(  RAD, DDA, 2 )
    	CALL IFPLOT(  0.0, DDD, 2 )
    	DDA = DDA - ADD - ADD
    	DDD = DDD - ADD - ADD
    	CALL IFPLOT(  0.0, DDA, 3 )
    	CALL IFPLOT( -RAD, DDD, 2 )
    	CALL IFPLOT(  RAD, DDD, 2 )
    	CALL IFPLOT(  0.0, DDA, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_CIRCLE( SIZE )
     	RAD = SIZE
     	CALL IFPLOT( RAD, 0.0, 3 )
     	DO I=20,360,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_RMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFPLOT( 0.0, -RAD, 3 )
     	DO I=-70,90,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( 0.0, RAD, 3 )
     	DO I=110,270,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_LMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFPLOT( 0.0, RAD, 3 )
     	DO I=110,270,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( 0.0, -RAD, 3 )
     	DO I=-70,90,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_TMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFPLOT( RAD, 0.0, 3 )
     	DO I=20,180,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( -RAD, 0.0, 3 )
     	DO I=-160,0,20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_BMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFPLOT( RAD, 0.0, 3 )
     	DO I=-20,-180,-20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( -RAD, 0.0, 3 )
     	DO I=160,0,-20
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

C------------------------------------------------------------------------
C   ***  THE FOLLOWING IS A COLLECTION OF MISCELLANEOUS ROUTINES  ***
C------------------------------------------------------------------------

    	FUNCTION IFMISC_DECODE( TEXT, NK, NF, GF, KF )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY
C		NOV-1986
C
C	THIS ROUTINE IMPLEMENTS A FREE FORMAT INPUT PROCESSOR.
C
C	TEXT --- INPUT TEXTSTRING IN CHARACTER FORMAT TO BE DECODED.
C	NK ----- LENGTH OF "TEXT" IN NUMBER OF CHARACTERS.
C	NF ----- NUMBER OF REAL*4 DECIMALS TO BE DECODED FROM THE "TEXT".
C	GF ----- REAL*4 ARRAY TO STORE THE DECODED DECIMALS.
C	KF ----- INTEGER ARRAY TO FLAG WHICH ELEMENT OF THE "GF"
C	         ARRAY GETS AN INPUT: 0=NO, 1=YES.
C
C	IFMISC_DECODE:
C
C		 RETURN WITH ZERO IF ERROR OCCURS IN DECODING OR ELSE
C		 THE POSITION OF THE LAST CHARACTER IN THE "TEXT"
C	         THAT DOESN'T GET DECODED. IN OTHER WORDS, IT FLAGS
C	         HOW MANY CHARACTERS HAVE BEEN USED, COUNTED FROM
C	         THE LEFT TO RIGHT IN THE "TEXT", TO DECODE THE "NF"
C	         REAL*4 DECIMALS.
C
C	COMMENTS:
C
C	THE FIELD SEPARATOR CAN BE EITHER A SPACE OR SPACES OR COMMA.
C	TO SKIP A FIELD, YOU HAVE TO USE THE COMMAS AND THE INPUT
C	PROCESSOR RETURNS WITH ITS "KF" = 0.
C
C	INTEGER FIELDS ARE DECODED AND STORED IN THE "GF" AS DECIMAL
C	NUMBERS. THEREFORE DECIMAL NUMBERS CAN BE ENTERED AS INTEGERS
C	AND VICE VERSA.
C
C	AN ERROR RESULTS IF THE INPUT PROCESSOR ENCOUNTERS TRAILING
C	TEXT CHARACTERS IN THE "TEXT" BEFORE THE "NF"TH DATA FIELD
C	GOT DECODED FROM THE "TEXT".
C	IF THERE IS NO TRAILING TEXT CHARACTERS IN THE "TEXT", THE
C	"TEXT" CAN HAVE FEWER THAN "NF" NUMBER OF DATA FIELDS AND
C	THE REST OF "GF" ARE FILLED WITH VALUES 0.0s AND THEIR "KF"s
C	WITH 0s.
C
    	CHARACTER SYM*1, BEL*1, STRN*40, TEXT*(*)
    	DIMENSION KF(NF), GF(NF), NCS(50), NSP(50)

    	NFS = NF
    	DO I=1, NFS
    	   KF(I) = 0
    	   GF(I) = 0.0
    	ENDDO
    	NLS = 0
    	NCH = NK
    	IF( NCH.EQ.0 ) GOTO 999
    	JMS = 1
    	NCS(JMS) = 0
    	NSP(JMS) = 0
    	BEL = ','
    	ICI = 0

    	DO 9 I=1, NCH
    	SYM = TEXT(I:I)
     	IF( SYM.EQ.'!' ) GOTO 2
    	IF( SYM.NE.',' ) GOTO 1
    	    IF( BEL.NE.' ' .OR. ICI.EQ.0 ) THEN
    	        JMS = JMS + 1
    		IF( ICI.EQ.0 ) THEN
    		    NSP(JMS) = I - NCS(JMS-1)
    		ELSE
    		    NSP(JMS) = 0
    		ENDIF
    	    ELSE
    	        NSP(JMS) = I - NCS(JMS)
    	    ENDIF
    	    NCS(JMS) = I
    	    NLS = I + 1
    	    ICI = 0
    	GOTO 6
1	IF( SYM.NE.' ' .OR. BEL.EQ.' ' .OR. BEL.EQ.',' ) GOTO 5
    	    JMS = JMS + 1
    	    NCS(JMS) = I
    	    NSP(JMS) = 0
    	GOTO 8
5	IF( SYM.EQ.' ' ) GOTO 8
    	NLS = I
6	IF( JMS.GT.NFS .OR. JMS.EQ.50 ) GOTO 10
8	BEL = SYM
    	IF( SYM.NE.' ' .AND. SYM.NE.',' ) ICI = 1
9	CONTINUE

2	NLS = I
    	JMS = JMS + 1
    	NCS(JMS) = I
    	NSP(JMS) = 0

10	DO I=1,JMS-1
    	   I1 = NCS(I) + 1
    	   I2 = NCS(I+1) - 1 - NSP(I+1)
    	   NCH = I2 - I1 + 1
     	   IF( NCH.GT.39 ) GOTO 888
    	   IF( NCH.GT.0 ) THEN
     	       STRN = TEXT(I1:I2)
    	       ICI  = INDEX( STRN(1:NCH), '.' )
    	       IF( ICI.EQ.0 ) THEN
    		   NCH = NCH + 1
    		   STRN(NCH:NCH) = '.'
    	       ENDIF
    	       READ( STRN(1:NCH), 20, ERR=888 ) GF(I)
    	       KF(I) = 1
    	   ENDIF
    	ENDDO
20	FORMAT(G40.30)
    	GOTO 999
888	NLS = 0
999	IFMISC_DECODE = NLS
     	RETURN
    	END

     	FUNCTION IFMISC_COLLAPSE( TEXT )
C
C	THIS ROUTINE RETURNS THE LENGTH OF CHARACTER STRING "TEXT"
C	STRIPPED OFF BLANK SPACES AND INVISIBLE ASCII-CHARS.
C
    	CHARACTER TEXT*(*)
     	N = IFMISC_LENG( TEXT )
     	K = 0
     	DO I=1, N
     	   IF( ICHAR(TEXT(I:I)).GT.32 ) THEN
     	       K = K + 1
     	       TEXT(K:K) = TEXT(I:I)
     	   ENDIF
     	ENDDO
     	IF( K.LT.N ) TEXT(K+1:) = ' '
     	IFMISC_COLLAPSE = K
     	RETURN
     	END

    	FUNCTION IFMISC_STRIP( TEXT )
C
C	THIS ROUTINE RETURNS THE LENGTH OF CHARACTER STRING "TEXT"
C	STRIPPED OFF LEADING AND TRAILING BLANKS.
C
    	CHARACTER TEXT*(*)
     	K = 0
    	N = IFMISC_LENG( TEXT )
     	DO I=1, N
     	   IF( ICHAR(TEXT(I:I)).GT.32 ) THEN
     	       K = K + 1
     	       TEXT(K:K) = TEXT(I:I)
     	   ELSE IF( K.NE.0 ) THEN
     	       K = K + 1
     	       TEXT(K:K) = ' '
     	   ENDIF
     	ENDDO
     	IF( K.LT.N ) TEXT(K+1:) = ' '
     	IFMISC_STRIP = K
    	RETURN
	END

     	SUBROUTINE IFMISC_UPPER( K, TEXT )
     	CHARACTER TEXT*(*)
     	DO  J=1, K
     	    N = ICHAR(TEXT(J:J))
     	    IF( N.GT.96 .AND. N.LT.123 ) TEXT(J:J) = CHAR(N-32)
     	ENDDO
     	RETURN
     	END

     	FUNCTION IFMISC_LENG( TEXT )
     	CHARACTER STRN*132, TEXT*(*)

     	STRN = TEXT
     	DO K=132,1,-1
     	   IF( ICHAR(STRN(K:K)).GT.32 ) GOTO 9
     	ENDDO
        K = 0
  9	IFMISC_LENG = K
     	RETURN
     	END

    	FUNCTION IFMISC_NEXT( TEXT )
C
C	THIS ROUTINE RETURNS THE LENGTH OF CHARACTER STRING "TEXT"
C	AFTER THE FIRST SPACE IN "TEXT".
C
    	CHARACTER TEXT*(*)

     	K = IFMISC_LENG( TEXT )
     	J = INDEX( TEXT(1:K), ' ' )
     	IF( J.EQ.0 ) THEN
     	    TEXT = ' '
     	    K = 0
     	ELSE
     	    DO  I=J+1, K
     		IF( TEXT(I:I).NE.' ' ) GOTO 1
     	    ENDDO
  1	    TEXT = TEXT(I:)
     	    K = K-I+1
     	ENDIF
  9	IFMISC_NEXT = K
    	RETURN
	END

     	SUBROUTINE IFMISC_DEFEXT( FNAME, EXT )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE ATTACHES THE DEFAULT FILE EXTENSION
C	"EXT" TO A FILE "FNAME" MISSING ITS FILE EXTENSION.
C
     	CHARACTER FNAME*(*), EXT*(*)

     	N = INDEX( FNAME, ']' ) + 1
     	N = INDEX( FNAME(N:), '.' )
     	IF( N.GT.0 ) RETURN		!FILE EXTENSION EXISTS
     	N = INDEX( FNAME, ' ' )
     	FNAME(N:) = EXT

     	RETURN
     	END

    	SUBROUTINE IFMISC_NAMEXT( FNAME, EXT )
C
C  PROGRAMMER: R.S. ZHOU
C
C  	THIS ROUTINE ATTACHES FILE EXTENSION "EXT" TO "FNAME".
C
    	CHARACTER FNAME*(*), EXT*(*)

    	N = INDEX( FNAME, ']' )
    	M = INDEX( FNAME(N+1:), '.' )
    	IF( M.EQ.0 ) THEN
     	    M = INDEX( FNAME, ' ' )
     	ELSE
     	    M = N + M
     	ENDIF
    	FNAME(M:) = EXT

    	RETURN
    	END

    	FUNCTION IFMISC_DIGITS( IT )
C
C	THIS FUNCTION RETURNS WITH THE NUMBER OF DIGITS OF "IT".
C
    	ITT = IABS(IT)
    	IF( ITT.EQ.0 ) THEN
    	    IFMISC_DIGITS = 1
    	ELSE
    	    IFMISC_DIGITS = INT( LOG10(FLOAT(ITT)) ) + 1
    	    IF( IT.LT.0 ) IFMISC_DIGITS = IFMISC_DIGITS + 1
    	ENDIF

    	RETURN
    	END

     	SUBROUTINE IFMISC_SPAWN( COMM, MASK )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE SPAWNS A SYSTEM SUBPROCESS USING VMS'S
C	RUN-TIME LIBRARY (RTL) ROUTINE LIB$SPAWN.
C
C	COMM --- DCL COMMAND-STRING.
C	MASK --- FLAGS MASK (SEE RTL MANAUL FOR DETAILS).
C
     	CHARACTER COMM*(*), STRN*132

     	STRN = COMM
     	NCHS = IFMISC_NEXT( STRN )
     	IF( NCHS.EQ.0 ) THEN
     	    CALL IFMAC_KEYEXP(0)
     	    CALL IFINIT_LINE(-24)
     	    CALL IFANSI_LEDS(4)
     	    CALL IFANSI_VIDEO(47)
     	    WRITE(6,1)
  1	    FORMAT(' *** Type LOGOUT to get back to program ***')
     	    CALL LIB$SPAWN()
     	    CALL IFANSI_LEDS(0)
     	    CALL IFMAC_KEYEXP(1)
     	ELSE
     	    CALL LIB$SPAWN( STRN,,, MASK )
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE IFMISC_RANGE( N, A, B, R )
C
C	THIS ROUTINE FINDS MINIMUM AND MAXIMUM VALUES
C	IN ARRAY A, B.
C
     	DIMENSION A(1), B(1), R(1)

     	NPTS = N
     	AMIN = A(1)
     	AMAX = AMIN
     	BMIN = B(1)
     	BMAX = BMIN
     	DO  I=2, NPTS
     	    AA = A(I)
     	    IF( AA.LT.AMIN ) THEN
     		AMIN = AA
     	    ELSE IF( AA.GT.AMAX ) THEN
     		AMAX = AA
     	    ENDIF
     	    AA = B(I)
     	    IF( AA.LT.BMIN ) THEN
     		BMIN = AA
     	    ELSE IF( AA.GT.BMAX ) THEN
     		BMAX = AA
     	    ENDIF
     	ENDDO
     	R(1) = AMIN
     	R(2) = AMAX
     	R(3) = BMIN
     	R(4) = BMAX
     	RETURN
     	END

     	SUBROUTINE IFMISC_SORT( N, A )
C
C	MODIFIED SINGLETON SORT ROUTINE (CACM 12, 185 (1969)).
C	N IS NUMBER OF POINTS IN THE ARRAYS.
C
     	DIMENSION A(1)
     	INTEGER I, II, IJ, IL(16), IU(16), J, K, L, M
     	REAL S, T

     	II = 1
     	I = II
     	J = N
     	M = 1
  10	IF (I .GE. J) GO TO 100
C
C  ORDER ENDS AND MIDPOINT OF SEGMENT BOUNDED BY I AND J
C
  20	K = I
     	IJ = (I + J)/2
     	T = A(IJ)
     	IF (A(I) .LE. T) GO TO 30
     	A(IJ) = A(I)
     	A(I) = T
     	T = A(IJ)

  30	L = J
     	IF (A(J) .GE. T) GO TO 50
     	A(IJ) = A(J)
     	A(J) = T
     	T = A(IJ)

     	IF (A(I) .LE. T) GO TO 50
     	A(IJ) = A(I)
     	A(I) = T
     	T = A(IJ)
     	GO TO 50
C
C  INTERCHANGE ELEMENT .LE. T WITH ELEMENT .GE. T
C
  40	S = A(L)
     	A(L) = A(K)
     	A(K) = S
C
C  SCAN DOWN SEQUENCE BETWEEN K AND L FOR ELEMENT .LE. T
C
  50	L = L - 1
     	IF (A(L) .GT. T) GO TO 50
C
C  NOW SCAN UP FOR ELEMENT .GE. T
C
  60	K = K + 1
     	IF (A(K) .LT. T) GO TO 60
     	IF (K - L) 40, 70, 80
C
C  AVOID UNNECESSARY INTERCHANGE
C
  70	K = K + 1
     	L = L - 1
C
C  STACK ENDPOINTS OF LONGER SEQUENCE
C
  80	IF (L - I .LE. J - K) GO TO 90
     	IL(M) = I
     	IU(M) = L
     	M = M + 1
     	I = K
     	GO TO 110

  90	IL(M) = K
     	IU(M) = J
     	M = M + 1
     	J = L
     	GO TO 110
C
C  UNSTACK A SAVED SEQUENCE
C
  100	M = M - 1
     	IF (M .EQ. 0) RETURN
     	I = IL(M)
     	J = IU(M)
C
C  SELECT SORTING METHOD
C
  110	IF (J - I .GE. 11) GO TO 20
     	IF (I .EQ. II) GO TO 10
C
C  SHORT SEQUENCES (EXCEPT THE FIRST) ARE ORDERED BY A SINKING SORT
C
     	I = I - 1
  120	I = I + 1
     	IF (I .EQ. J) GO TO 100
     	IF (A(I) .LE. A(I+1)) GO TO 120
     	T = A(I+1)
     	K = I
  130	A(K+1) = A(K)
     	K = K - 1
     	IF (A(K) .GT. T) GO TO 130
     	A(K+1) = T
     	GO TO 120
     	END

     	SUBROUTINE IFMISC_SORT_ONE( N, A, B )
C
C	MODIFIED SINGLETON SORT ROUTINE (CACM 12, 185 (1969)).
C	B IS PASSIVE ARRAY TO BE SORTED ON A.
C	N IS NUMBER OF POINTS IN THE ARRAYS.
C
     	DIMENSION A(1), B(1)
     	INTEGER I, II, IJ, IL(16), IU(16), J, K, L, M
     	REAL S, T, U

     	II = 1
     	I = II
     	J = N
     	M = 1
  10	IF (I .GE. J) GO TO 100
C
C  ORDER ENDS AND MIDPOINT OF SEGMENT BOUNDED BY I AND J
C
  20	K = I
     	IJ = (I + J)/2
     	T = A(IJ)
     	IF (A(I) .LE. T) GO TO 30
     	A(IJ) = A(I)
     	A(I) = T
     	T = A(IJ)
     	U = B(I)
     	B(I) = B(IJ)
     	B(IJ) = U

  30	L = J
     	IF (A(J) .GE. T) GO TO 50
     	A(IJ) = A(J)
     	A(J) = T
     	T = A(IJ)
     	U = B(IJ)
     	B(IJ) = B(J)
     	B(J) = U

     	IF (A(I) .LE. T) GO TO 50
     	A(IJ) = A(I)
     	A(I) = T
     	T = A(IJ)
     	U = B(IJ)
     	B(IJ) = B(I)
     	B(I) = U
     	GO TO 50
C
C  INTERCHANGE ELEMENT .LE. T WITH ELEMENT .GE. T
C
  40	S = A(L)
     	A(L) = A(K)
     	A(K) = S
     	U = B(L)
     	B(L) = B(K)
     	B(K) = U
C
C  SCAN DOWN SEQUENCE BETWEEN K AND L FOR ELEMENT .LE. T
C
  50	L = L - 1
     	IF (A(L) .GT. T) GO TO 50
C
C  NOW SCAN UP FOR ELEMENT .GE. T
C
  60	K = K + 1
     	IF (A(K) .LT. T) GO TO 60
     	IF (K - L) 40, 70, 80
C
C  AVOID UNNECESSARY INTERCHANGE
C
  70	K = K + 1
     	L = L - 1
C
C  STACK ENDPOINTS OF LONGER SEQUENCE
C
  80	IF (L - I .LE. J - K) GO TO 90
     	IL(M) = I
     	IU(M) = L
     	M = M + 1
     	I = K
     	GO TO 110

  90	IL(M) = K
     	IU(M) = J
     	M = M + 1
     	J = L
     	GO TO 110
C
C  UNSTACK A SAVED SEQUENCE
C
  100	M = M - 1
     	IF (M .EQ. 0) RETURN
     	I = IL(M)
     	J = IU(M)
C
C  SELECT SORTING METHOD
C
  110	IF (J - I .GE. 11) GO TO 20
     	IF (I .EQ. II) GO TO 10
C
C  SHORT SEQUENCES (EXCEPT THE FIRST) ARE ORDERED BY A SINKING SORT
C
     	I = I - 1
  120	I = I + 1
     	IF (I .EQ. J) GO TO 100
     	IF (A(I) .LE. A(I+1)) GO TO 120
     	T = A(I+1)
     	U = B(I+1)
     	K = I
  130	A(K+1) = A(K)
     	B(K+1) = B(K)
     	K = K - 1
     	IF (A(K) .GT. T) GO TO 130
     	A(K+1) = T
     	B(K+1) = U
     	GO TO 120
     	END

     	SUBROUTINE IFMISC_SORT_TWO( N, A, B, C )
C
C	MODIFIED SINGLETON SORT ROUTINE (CACM 12, 185 (1969)).
C	B AND C ARE PASSIVE ARRAYS TO BE SORTED ON A.
C	N IS NUMBER OF POINTS IN THE ARRAYS.
C
     	DIMENSION A(1), B(1), C(1)
     	INTEGER I, II, IJ, IL(16), IU(16), J, K, L, M
     	REAL S, T, U, V

     	II = 1
     	I = II
     	J = N
     	M = 1
  10	IF (I .GE. J) GO TO 100
C
C  ORDER ENDS AND MIDPOINT OF SEGMENT BOUNDED BY I AND J
C
  20	K = I
     	IJ = (I + J)/2
     	T = A(IJ)
     	IF (A(I) .LE. T) GO TO 30
     	A(IJ) = A(I)
     	A(I) = T
     	T = A(IJ)
     	U = B(I)
     	B(I) = B(IJ)
     	B(IJ) = U
     	U = C(I)
     	C(I) = C(IJ)
     	C(IJ) = U

  30	L = J
     	IF (A(J) .GE. T) GO TO 50
     	A(IJ) = A(J)
     	A(J) = T
     	T = A(IJ)
     	U = B(IJ)
     	B(IJ) = B(J)
     	B(J) = U
     	U = C(IJ)
     	C(IJ) = C(J)
     	C(J) = U

     	IF (A(I) .LE. T) GO TO 50
     	A(IJ) = A(I)
     	A(I) = T
     	T = A(IJ)
     	U = B(IJ)
     	B(IJ) = B(I)
     	B(I) = U
     	U = C(IJ)
     	C(IJ) = C(I)
     	C(I) = U
     	GO TO 50
C
C  INTERCHANGE ELEMENT .LE. T WITH ELEMENT .GE. T
C
  40	S = A(L)
     	A(L) = A(K)
     	A(K) = S
     	U = B(L)
     	B(L) = B(K)
     	B(K) = U
     	U = C(L)
     	C(L) = C(K)
     	C(K) = U
C
C  SCAN DOWN SEQUENCE BETWEEN K AND L FOR ELEMENT .LE. T
C
  50	L = L - 1
     	IF (A(L) .GT. T) GO TO 50
C
C  NOW SCAN UP FOR ELEMENT .GE. T
C
  60	K = K + 1
     	IF (A(K) .LT. T) GO TO 60
     	IF (K - L) 40, 70, 80
C
C  AVOID UNNECESSARY INTERCHANGE
C
  70	K = K + 1
     	L = L - 1
C
C  STACK ENDPOINTS OF LONGER SEQUENCE
C
  80	IF (L - I .LE. J - K) GO TO 90
     	IL(M) = I
     	IU(M) = L
     	M = M + 1
     	I = K
     	GO TO 110

  90	IL(M) = K
     	IU(M) = J
     	M = M + 1
     	J = L
     	GO TO 110
C
C  UNSTACK A SAVED SEQUENCE
C
  100	M = M - 1
     	IF (M .EQ. 0) RETURN
     	I = IL(M)
     	J = IU(M)
C
C  SELECT SORTING METHOD
C
  110	IF (J - I .GE. 11) GO TO 20
     	IF (I .EQ. II) GO TO 10
C
C  SHORT SEQUENCES (EXCEPT THE FIRST) ARE ORDERED BY A SINKING SORT
C
     	I = I - 1
  120	I = I + 1
     	IF (I .EQ. J) GO TO 100
     	IF (A(I) .LE. A(I+1)) GO TO 120
     	T = A(I+1)
     	U = B(I+1)
     	V = C(I+1)
     	K = I
  130	A(K+1) = A(K)
     	B(K+1) = B(K)
     	C(K+1) = C(K)
     	K = K - 1
     	IF (A(K) .GT. T) GO TO 130
     	A(K+1) = T
     	B(K+1) = U
     	C(K+1) = V
     	GO TO 120
     	END

     	SUBROUTINE IFMISC_FILTER( NPTS, YDAT, NDEG, NFIL )
C
C  PROGRAMMER: R.S. ZHOU	JUNE-1986
C
C	THIS ROUTINE IMPLEMENTS THE SAVITZKY-GOLAY SIMPLIFIED
C	LEAST SQUARE ALGORITHM FOR DATA SMOOTHING.
C
C	NPTS --- NUMBER OF DATA POINTS IN THE ARRAY.
C	YDAT --- ARRAY TO BE FILTERED.
C	NDEG --- POLYNOMIAL DEGREE (2,3,4,5).
C	NFIL --- FILTER LENGTH IN NUMBER OF DATA POINTS (5,7,9).
C
    	DIMENSION YDAT(1)
    	DIMENSION IC2(10,3), IC4(10,2)

    	DATA IC2 /
     + -3,  12,  17,  12,  -3,  35,   0,   0,   0,   0,
     + -2,   3,   6,   7,   6,   3,  -2,  21,   0,   0,
     +-21,  14,  39,  54,  59,  54,  39,  14, -21, 231 /

    	DATA IC4 /
     +  5,  -30,  75, 131,  75, -30,   5, 231,   0,   0,
     + 15,  -55,  30, 135, 179, 135,  30, -55,  15, 429 /

    	NF = NFIL
    	MF = NF/2 - 1
     	MM = NPTS
     	MID= 0

    	IF( NDEG.LT.4 ) THEN
     	    DO  J=1, MM-NF+1
     		SUM = 0.0
     		DO  K=1, NF
     		    SUM = SUM + YDAT(J+K-1)*IC2(K,MF)
     		ENDDO
     		MID = MID + 1
     		YDAT(MID) = SUM/IC2(K,MF)
     	    ENDDO
     	ELSE
     	    IF( NF.LT.7 ) NF = 7
    	    MF = MF - 1
     	    DO  J=1, MM-NF+1
     		SUM = 0.0
     		DO  K=1, NF
     		    SUM = SUM + YDAT(J+K-1)*IC4(K,MF)
     		ENDDO
     		MID = MID + 1
     		YDAT(MID) = SUM/IC4(K,MF)
     	    ENDDO
     	ENDIF

     	RETURN
    	END

     	SUBROUTINE IFMISC_DERIV( NPTS, YDAT, NDEG, NFIL, NDEV )
C
C  PROGRAMMER: R.S. ZHOU	JUNE-1986
C
C	THIS ROUTINE IMPLEMENTS THE SAVITZKY-GOLAY SIMPLIFIED
C	LEAST SQUARE ALGORITHM FOR DATA DIFFERENTIATION.
C
C	NPTS --- NUMBER OF DATA POINTS IN THE ARRAY.
C	YDAT --- INPUT DATA ARRAY TO BE FILTRATED.
C	NDEG --- POLYNOMIAL DEGREE (2,3,4).
C	NFIL --- FILTER LENGTH IN NUMBER OF DATA POINTS (5,7,9).
C	NDEV --- DERIVATIVE ORDER (1,2).
C
    	DIMENSION YDEV(10), YDAT(1)
    	DIMENSION ID12(10,3), ID14(10,3), ID22(10,3), ID24(10,3)

    	DATA ID12 /
     + -2,   -1,    0,    1,    2,   10,    0,    0,    0,    0,
     + -3,   -2,   -1,    0,    1,    2,    3,   28,    0,    0,
     + -4,   -3,   -2,   -1,    0,    1,    2,    3,    4,   60 /

    	DATA ID14 /
     +  1,   -8,    0,    8,   -1,   12,    0,    0,    0,    0,
     + 22,  -67,  -58,    0,   58,   67,  -22,  252,    0,    0,
     + 86, -142, -193, -126,    0,  129,  193,  142,  -86, 1188 /

    	DATA ID22 /
     +  2,   -1,   -2,   -1,   -2,    7,    0,    0,    0,    0,
     +  5,    0,   -3,   -4,   -3,    0,    5,   42,    0,    0,
     + 28,    7,   -8,  -17,  -20,  -17,   -8,    7,   28,  462 /

    	DATA ID24 /
     +    -3,   48,  -90,   48,   -3,    3,    0,    0,    0,    0,
     +  -117,  603, -171, -630, -171,  603, -117,   99,    0,    0,
     + -4158,12243, 4983,-6963,-12210,-6963,4983,12243,-4158, 4719 /

    	NO = NDEV
    	ND = NDEG
    	NF = NFIL
     	MM = NPTS
    	MF = NF/2 - 1
    	MID= 0
     	JK = 0
    	IF( NO.EQ.1 ) THEN
    	    IF( ND.LT.3 ) THEN
     		DO  J=1, MM-NF+1
     		    SUM = 0.0
     		    DO  K=1, NF
     			SUM = SUM + YDAT(J+K-1)*ID12(K,MF)
     		    ENDDO
     		    JK = JK + 1
     		    YDEV(JK) = SUM/ID12(K,MF)
     		    IF( JK.EQ.NF ) THEN
     			DO  I=1, NF
     			    MID = MID + 1
     			    YDAT(MID) = YDEV(I)
     			ENDDO
     			JK = 0
     		    ENDIF
     		ENDDO
    	    ELSE
     		DO  J=1, MM-NF+1
     		    SUM = 0.0
     		    DO  K=1, NF
     			SUM = SUM + YDAT(J+K-1)*ID14(K,MF)
     		    ENDDO
     		    JK = JK + 1
     		    YDEV(JK) = SUM/ID14(K,MF)
     		    IF( JK.EQ.NF ) THEN
     			DO  I=1, NF
     			    MID = MID + 1
     			    YDAT(MID) = YDEV(I)
     			ENDDO
     			JK = 0
     		    ENDIF
     		    MID = MID + 1
     		ENDDO
    	    ENDIF
     	ELSE
    	    IF( ND.LT.4 ) THEN
     		DO  J=1, MM-NF+1
     		    SUM = 0.0
     		    DO  K=1, NF
     			SUM = SUM + YDAT(J+K-1)*ID22(K,MF)
     		    ENDDO
     		    JK = JK + 1
     		    YDEV(JK) = SUM/ID22(K,MF)
     		    IF( JK.EQ.NF ) THEN
     			DO  I=1, NF
     			    MID = MID + 1
     			    YDAT(MID) = YDEV(I)
     			ENDDO
     			JK = 0
     		    ENDIF
     		ENDDO
     	    ELSE
     		DO  J=1, MM-NF+1
     		    SUM = 0.0
     		    DO  K=1, NF
     			SUM = SUM + YDAT(J+K-1)*ID24(K,MF)
     		    ENDDO
     		    JK = JK + 1
     		    YDEV(JK) = SUM/ID24(K,MF)
     		    IF( JK.EQ.NF ) THEN
     			DO  I=1, NF
     			    MID = MID + 1
     			    YDAT(MID) = YDEV(I)
     			ENDDO
     			JK = 0
     		    ENDIF
     		ENDDO
    	    ENDIF
     	ENDIF

     	IF( JK.GT.0 ) THEN
     	    DO  I=1, JK
     		MID = MID + 1
     		YDAT(MID) = YDEV(I)
     	    ENDDO
     	ENDIF

     	RETURN
    	END

     	SUBROUTINE IFMISC_OOPS( ME, IL, IC, INPUT )
C
C	THIS ROUTINE DISPLAYS ERROR MESSAGE FOR GRAFIT.
C
     	CHARACTER JUNK*1, MESS*75, INPUT*(*)
     	BYTE      BEEP
     	OPEN( UNIT=13, FILE='GRAFIT$EXE:GRAFIT.ERR',
     +        STATUS='OLD', READONLY, ERR=999 )
     	DO I=1, ME-1
     	   READ(13,112,ERR=999,END=999) JUNK
     	ENDDO
     	READ(13,111,ERR=999,END=999) MESS
  111	FORMAT(5X,A75)
  112	FORMAT(A1)
     	I = IFMISC_LENG(MESS)
     	IF( INPUT.NE.' ' ) THEN
     	    MESS(I+2:) = INPUT
     	    I = IFMISC_LENG(MESS)
     	ENDIF
     	IF( I.GT.0 ) THEN
     	    BEEP = 7
     	    WRITE(6,333) BEEP
  333       FORMAT(1X,A1)
     	    IF( IL.EQ.0 .OR. IC.EQ.0 ) THEN
     		WRITE(6,222) MESS(1:I)
  222		FORMAT('_oops: ',A)
     	    ELSE
     		CALL IFANSI_TEXT( MESS(1:I), I, IL, IC+1 )
     	    ENDIF
     	ENDIF
  999	CLOSE(13)
     	RETURN
     	END

     	SUBROUTINE IFMISC_TIME
     	CHARACTER TEXT*8
     	CALL TIME( TEXT )
     	CALL IFANSI_VIDEO(12)
     	CALL IFANSI_VIDEO(80)
     	CALL IFANSI_TEXT( TEXT, 8, 1, 73 )
     	RETURN
     	END

     	FUNCTION IFMISC_PROMPT( PROMPT, TEXT, IL, IC )
     	CHARACTER FNAME*32, PROMPT*(*), TEXT*(*)

     	NCHS = IFMISC_LENG(PROMPT)
     	IF( IL.EQ.0 .OR. IC.EQ.0 ) THEN
     	    WRITE(6,1) PROMPT(1:NCHS)
  1	    FORMAT(1X,A,1X,$)
     	ELSE
     	    CALL IFANSI_TEXT( PROMPT, NCHS+1, IL, IC )
     	ENDIF
     	READ(5,1000,END=999) FNAME
1000	FORMAT(A32)
     	NCHS = 0
     	IF( FNAME.NE.' ' ) THEN
     	    NCHS = IFMISC_STRIP(FNAME)
     	    CALL   IFMISC_UPPER(NCHS,FNAME)
     	    TEXT = FNAME
     	ENDIF
     	IFMISC_PROMPT = NCHS
     	RETURN
999	IFMISC_PROMPT = 0
     	RETURN
     	END

     	FUNCTION IFMISC_HLP( PNAME, KEYWORD, IL, IC )
C
C	THIS ROUTINE DISPLAYS ON-LINE.
C
     	CHARACTER KEY*4, HELPFILE*32, TEXT*32, PNAME*(*), KEYWORD*(*)

     	HELPFILE = 'GRAFIT$HLP:'
     	HELPFILE(12:) = PNAME
     	MCHS = IFMISC_LENG(PNAME) + 12
     	TEXT = KEYWORD
     	NCHS = IFMISC_NEXT(TEXT)
     	IF( NCHS.EQ.2 .AND. TEXT(1:2).NE.'AC' ) THEN
     	    HELPFILE(MCHS:) = '_LINE.HLP'
     	    IERR = IFMISC_HELP( HELPFILE, TEXT, IL, IC )
     	    IERR = 1
     	ELSE
     	    IF( NCHS.EQ.0 ) THEN
     		KEY = 'HELP'
     	    ELSE
     		KEY  = TEXT
     		IERR = INDEX( TEXT(1:NCHS), '/ALL' )
     		IF(IERR.EQ.0) IERR =INDEX( TEXT(1:NCHS), '/MORE' )
     		IF(IERR.EQ.0) IERR =INDEX( TEXT(1:NCHS), '/FULL' )
     		IF(IERR.GT.1) KEY  =TEXT(1:IERR-1)
     	    ENDIF
     	    IF( TEXT(1:2).NE.'AC' ) THEN
     		HELPFILE(MCHS:) = '_HELP.HLP'
     	    ELSE
     		HELPFILE(MCHS:) = '_LINE.HLP'
     	    ENDIF
     	    IERR = IFMISC_TYPE( HELPFILE, KEY, IL )
     	    IF( IERR.GT.0 ) GOTO 888
     	ENDIF
     	GOTO 999
C
C  ERROR TRANSFER...
C
888	IF( IERR.EQ.1 ) THEN
     	    CALL IFMISC_OOPS( 9, IL, IC, ' ' )
     	ELSE
     	    CALL IFMISC_OOPS( 8, IL, IC, TEXT )
     	ENDIF
999	IFMISC_HLP = IERR
     	RETURN
     	END

     	FUNCTION IFMISC_HELP(FILE,KEYW,IL,IC)
C
C	THIS ROUTINE DISPLAYS ONE-LINE ON-LINE HELP.
C
C	 FILE: FILE TO BE OPENED AND READ.
C	 KEYW: KEY-WORD TO SEARCH FOR THE LINE.
C	IL,IC: CURSOR POSTION TO PRINT THE LINE.
C
C	IFMISC_HELP=0: OK READ.
C	IFMISC_HELP=1: CAN NOT OPEN/FIND THE FILE.
C	IFMISC_HELP=2: NO INFORMATION FOR THE INPUT KEYWORD.
C
     	CHARACTER HELP*80, KEY*4, KEYW*(*), PNAME*32, FILE*(*)
     	LOGICAL   YES

     	IERR  = 0
     	PNAME = FILE
     	INQUIRE( FILE=PNAME, EXIST=YES )
     	IF( .NOT.YES ) GOTO 888
     	OPEN(UNIT=1,FILE=PNAME,STATUS='OLD',FORM='FORMATTED',
     +       CARRIAGECONTROL='LIST',READONLY,ERR=888)
     	KEY = KEYW
     	NCH = IFMISC_STRIP( KEY )
     	CALL  IFMISC_UPPER( NCH, KEY )
1	READ(1,2,END=777) HELP
2	FORMAT(A)
     	IF( HELP.EQ.' ' ) GOTO 1
     	IF( HELP(1:NCH).NE.KEY(1:NCH) ) GOTO 1
     	HELP = HELP(NCH+2:)
     	NCHS = IFMISC_STRIP( HELP )
     	IF( IL.GT.0 .AND. IC.GT.0 ) THEN
     	    IF( NCHS.GT.80-IC ) NCHS = 80-IC
     	    CALL IFANSI_CURSOR(IL,IC)
     	    CALL IFANSI_CLEAR(4)
     	    CALL IFANSI_TEXT( HELP, NCHS, IL, IC+1 )
     	ELSE
     	    WRITE(6,666) KEY(1:NCH), HELP(1:NCHS)
666	    FORMAT(1X,A,': ',A)
     	ENDIF
     	GOTO 999

777	CALL IFMISC_OOPS( 8, IL, IC, KEY )
     	IERR = 2
     	GOTO 999
888	CALL IFMISC_OOPS( 9, IL, IC, ' ' )
     	IERR = 1
999	CLOSE(UNIT=1)
     	IFMISC_HELP = IERR
     	RETURN
     	END

    	FUNCTION IFMISC_TYPE( PNAME, KEYWD, ILINE )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY 1986
C
C	THIS ROUTINE DISPLAYS AN ASCII FILE.
C
C	FNAME ---- ASCII FILE IN CHARACTER FORMAT TO BE TYPED.
C	KEYWD ---- KEYWORD TO SEARCH FOR THE DESIRED PARAGRAPH.
C		   KEYWORD MUST BE LEAD BY A DOT ".".
C		   IF KEYWORD IS BLANK, THE WHOLE FILE IS DISPLAYED.
C	ILINE ---- ILINE>0: DISPLAYED IN "ILINE" LINES PER PAGE.
C		   ILINE=0: DISPLAYED WITHOUT PAUSE.
C		   ILINE<0: DISPLAYED AND RESET DIALOG AREA LINE AS NEEDED.
C
C	IFMISC_TYPE=0: OK READ.
C	IFMISC_TYPE=1: CAN NOT OPEN/FIND THE FILE.
C	IFMISC_TYPE=2: NO INFORMATION FOR THE INPUT KEYWORD.
C
    	CHARACTER KEY*5, FNAME*32, PNAME*(*), KEYW*4, KEYWD*(*)
     	CHARACTER DOT*1, TEXT*80
     	LOGICAL   YES
        EQUIVALENCE (DOT,TEXT(1:1)), (DOT,KEY(1:1))

     	IERR  = 0
	FNAME = PNAME
    	INQUIRE( FILE=FNAME, EXIST=YES )
     	IF( .NOT.YES ) GOTO 888
     	OPEN( UNIT=1, FILE=FNAME, STATUS='OLD', FORM='FORMATTED',
     +        CARRIAGECONTROL='LIST', READONLY, ERR=888 )

     	CALL IFANSI_VIDEO(47)
	ILN  = ILINE
     	KEYW = KEYWD
     	NCH  = IFMISC_STRIP(KEYW)
     	CALL   IFMISC_UPPER(NCH,KEYW)
	IF( NCH.EQ.0 ) THEN
     	    CALL IFANSI_MARGIN(0,0)
	    NPS = 0
	    IF( ILN.GT.0 ) THEN
     		CALL IFINIT_LINE(24)
     	    ELSE
     		CALL IFANSI_CLEAR(0)
     	    ENDIF
   1	    READ(1,2,END=111) TEXT
	    IF( DOT.EQ.'.' ) GOTO 1
     	    NK = IFMISC_LENG( TEXT )
     	    IF( NK.GT.0 ) THEN
                WRITE(6,3) TEXT(1:NK)
            ELSE
                WRITE(6,4)
            ENDIF
	    IF( ILN.EQ.0 ) GOTO 1
	    NPS = NPS + 1
	    IF( ILN.GT.0 .AND. ILN.EQ.NPS ) THEN
     		CALL IFANSI_VIDEO(30)
	        WRITE(6,5)
     		CALL IFANSI_VIDEO(47)
	        CALL IFQIOW_KEY( NPS )
     		IF( NPS.EQ.26 .OR. NPS.EQ.13 ) GOTO 999
		NPS = 0
     		CALL IFANSI_CLEAR(6)
     		CALL IFANSI_CURSOR(-2,0)
	    ENDIF
	    GOTO 1
	ELSE
 10	    READ(1,2,END=777) KEY
	    IF( DOT.NE.'.' ) GOTO 10
	    IF( KEYW(1:NCH).NE.KEY(2:NCH+1) ) GOTO 10
	    NPS = 0
     	    CALL IFANSI_CLEAR(0)
	    IF( ILN.GT.0 ) CALL IFINIT_LINE(ILN+2)
 20	    READ(1,2,END=111) TEXT
	    IF( DOT.EQ.'.' ) GOTO 111
     	    NK = IFMISC_LENG( TEXT )
     	    IF( NK.GT.0 ) THEN
                WRITE(6,3) TEXT(1:NK)
            ELSE
                WRITE(6,4)
            ENDIF
	    IF( ILN.EQ.0 ) GOTO 20
	    NPS = NPS + 1
	    IF( ILN.GT.0 .AND. ILN.EQ.NPS ) THEN
     		CALL IFANSI_VIDEO(30)
	        WRITE(6,5)
     		CALL IFANSI_VIDEO(47)
	        CALL IFQIOW_KEY( NPS )
     		IF( NPS.EQ.26 .OR. NPS.EQ.13 ) GOTO 999
		NPS = 0
     		CALL IFANSI_CLEAR(6)
     		CALL IFANSI_CURSOR(-2,0)
	    ENDIF
	    GOTO 20
	ENDIF
 111	IF( NPS.GT.0 ) THEN
	    IF( ILN.LT.0 ) CALL IFINIT_LINE( ILN-NPS )
	    IF( ILN.GT.0 ) THEN
     		CALL IFANSI_VIDEO(30)
	        WRITE(6,5)
     		CALL IFANSI_VIDEO(47)
	        CALL IFQIOW_KEY( NPS )
	    ENDIF
	ENDIF
	GOTO 999
 2	FORMAT(A)
 3	FORMAT(1X,A)
 4	FORMAT(' ')
 5	FORMAT(' Press SPACEBAR to continue... RETURN to quit...',$)

 777	IERR = 2
	GOTO 999
 888	IERR = 1
 999    CLOSE(UNIT=1)
     	IFMISC_TYPE = IERR
    	RETURN
    	END

      SUBROUTINE IFMISC_SMOOTH( NP, YA, WA, IT )
C
C     THIS ROUTINE SMOOTHS DATA USING 5-POINT CUBIC LS FIT.
C
C     NP ---- NUMBER OF DATA POINTS TO SMOOTH.
C     YA ---- DATA ARRAYS OF NP.
C     WA ---- WORKING ARRAY OF NP.
C     IT ---- ITERATION TIMES.
C
      REAL YA(1), WA(1)

      N = NP
      IF( N.LT.5 ) RETURN
      ITER = IT
      IF( ITER.LT.1 ) ITER = 1
      DO K=1, ITER
         DO I=1, N
            WA(I) = YA(I)
         ENDDO
         YA(1) = (69*WA(1)+4*(WA(2)+WA(4))-6*WA(3)-WA(5))/70
         YA(2) = (2*(WA(1)+WA(5))+27*WA(2)+12*WA(3)-8*WA(4))/35
         DO I=3, N-2
         YA(I)=(12*(WA(I-1)+WA(I+1))+17*WA(I)-3*(WA(I-2)+WA(I+1)))/35
         ENDDO
         YA(N-1)=(2*(WA(N-4)+WA(N))-8*WA(N-3)+12*WA(N-2)+27*WA(N-1))/35
         YA(N  )=(4*(WA(N-3)+WA(N-1))-WA(N-4)-6*WA(N-2)+69*WA(N))/70
      ENDDO
      RETURN
      END

    	SUBROUTINE IFOBLI( XOP, YOP, RAD1, RAD2, RAD3, ANGLE )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE DRAWS AN OBLIQUE.
C
C	XOP ------- X-COORDINATE OF THE CENTER IN INCHES.
C	YOP ------- Y-COORDINATE OF THE CENTER IN INCHES.
C	RAD1 ------ DIAMETER OF OBLIQUE IN X-AXIS IN INCHES.
C	RAD2 ------ DIAMETER OF OBLIQUE IN Y-AXIS IN INCHES.
C	RAD3 ------ BORDER WIDTH (INWARD) IN INCHES.
C	ANGLE ----- ROTATION ANGLE OF OBJECT IN DEGREES FROM X-AXIS.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( ABS(RAD1).LT.0.05 .OR. ABS(RAD2).LT.0.05 ) RETURN
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
C
C  INITIALIZE...
C
     	IDW = 0
     	XPS = XOP
     	YPS = YOP
     	RD1 = 0.5*ABS(RAD1)
     	RD2 = 0.5*ABS(RAD2)
     	WID = ABS(RAD3)
     	IF( WID.GE.RD1 .OR. WID.GE.RD2 ) WID = 0.0
     	ANG = AMOD( ANGLE, 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	CALL IFPLOT( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( ANG.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANG+XANG, ANG+YANG )
     	ENDIF
C
C  START THE DRAWING...
C
111	CALL IFPLOT( RD1, 0.0, 3 )
     	CALL IFPLOT( 0.0, RD2, 2 )
     	CALL IFPLOT(-RD1, 0.0, 2 )
     	CALL IFPLOT( 0.0,-RD2, 2 )
     	CALL IFPLOT( RD1, 0.0, 2 )
     	IF( WID.EQ.0.0 ) GOTO 222
     	RDD = WID*SQRT(RD1*RD1+RD2*RD2)
     	WID = RD1 - RDD/RD2
     	RD2 = RD2 - RDD/RD1
     	RD1 = WID
     	WID = 0.0
     	GOTO 111
C
C  RESTORE...
C
222	IF( ANG.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XOP, -YOP, -9 )

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) RAD1,RAD2,RAD3, XOP,YOP, ANGLE
     	ENDIF
1000	FORMAT('OBLI:',6F8.3)
     	IDW = IWD

999	RETURN
    	END
	SUBROUTINE IFPACK_TEKINT( INTVAR )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	INTEGER PACKING FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	THIS ROUTINE PACKS ONE INTEGER AS SPECIFIED BY TEKTRONIX 4100
C	SERIES TERMINALS FOR INTEGER PARAMETERS.
C
C	**READ TEKTRONIX MANUAL FOR PACKING CONVENTION **
C
    	INCLUDE 'TEKLIB.CBS'

	BYTE IST
	N = IABS(INTVAR)
C
C  PACK HIGH 6-BITS...
C
    	IST = IBITS( N, 10, 6 )
    	IF( IST.GT.0 ) THEN
    	    IPL = IPL + 1
    	    IPB(IPL) = IST + 64
    	ENDIF
C
C  PACK MIDDLE 6-BITS...
C
    	IST = IBITS( N, 4, 6 )
    	IF( IST.GT.0 ) THEN
    	    IPL = IPL + 1
    	    IPB(IPL) = IST + 64
    	ENDIF
C
C  PACK LOW 4-BITS...
C
    	IST = IBITS( N, 0, 4 ) + 32
    	IF(INTVAR.GE.0) IST = IST + 16
    	IPL = IPL + 1
    	IPB(IPL) = IST

    	RETURN
    	END

     	SUBROUTINE IFPACK_TEKXY( IX, IY )
C
C  PROGRAMMER: R.S. ZHOU 		FEB-1986
C
C	INTEGER X,Y COORDINATES PACKING FOR TEK 4100 SERIES TERMINALS.
C
C	THIS ROUTINE PACKS PAIR X,Y INTEGERS AS SPECIFIED BY TEK 4100
C	SERIES TERMINALS FOR X,Y COORDINATES.
C
C	**READ TEKTRONIX MANUAL FOR PACKING CONVENTION **
C
C -----------------------------------------------------------------------
C
    	INCLUDE 'TEKLIB.CBS'

	LX = IABS(IX)
	LY = IABS(IY)
    	IPB(IPL+1) = IBITS( LY, 7, 5 ) + 32			!PACK HI-Y
    	IPB(IPL+2) = 4*IBITS(LY,0,2) + IBITS(LX,0,2) + 96	!PACK EXTRAS
    	IPB(IPL+3) = IBITS( LY, 2, 5 ) + 96			!PACK LO-Y
    	IPB(IPL+4) = IBITS( LX, 7, 5 ) + 32			!PACK HI-X
    	IPB(IPL+5) = IBITS( LX, 2, 5 ) + 64			!PACK LO-X
    	IPL = IPL + 5

    	RETURN
    	END

    	SUBROUTINE IFPACK_REGIS( IXY )
    	INCLUDE 'TEKLIB.CBS'
    	CHARACTER TEXT*4
    	IN = IABS(IXY)
     	WRITE(TEXT,1) IN
C    	ENCODE( 4, 1, TEXT ) IN
 1	FORMAT(I4)
    	DO I=1, 4
     	   IN = ICHAR(TEXT(I:I))
    	   IF( IN.GT.47 ) THEN
    	       IPL = IPL + 1
    	       IPB(IPL) = IN
     	   ENDIF
     	ENDDO
    	RETURN
    	END

     	SUBROUTINE IFPACK_TEKDEC( DUM )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C	REAL PARAMETER PACKING FOR TEKTRONIX 4100 SERIES TERMINALS.
C
C	THIS ROUTINE PACKS ONE DECIMAL NUMBER AS TWO INTEGERS
C	AS SPECIFIED BY TEKTRONIX 4100 SERIES TERMINALS
C
C	**READ TEKTRONIX MANUAL FOR PACKING CONVENTION **
C
    	INCLUDE 'TEKLIB.CBS'
    	DATA FCT / 1024.0 /
C
C  THE APPROXIMATION MADE BELOW IS TO MULTIPLY THE "PAR" BY A
C  FACTOR OF 2**10, ROUND IT OFF AS THE FIRST INTEGER AND THEN
C  MULTIPLY IT BY A FACTOR OF 2**(-10), -10 AS THE 2ND INTEGER
C
    	DEC = DUM
    	IDEC = DEC
    	IF( FLOAT(IDEC) .EQ. DEC ) THEN
    	    CALL IFPACK_TEKINT( IDEC )
    	    IPL = IPL + 1
    	    IPB(IPL) = 48
    	ELSE
    	    IDEC = FCT*DEC
    	    CALL IFPACK_TEKINT( IDEC )
    	    CALL IFPACK_TEKINT( -10 )
    	ENDIF

    	RETURN
    	END

    	REAL*4 FUNCTION IFPACK_DECTEK( FCT )
C
C	THIS FUNCTION MAKES THE CORRESPONDING CORRECTION TO THE SCALE
C	FACTOR "FCT" TO WHICH APPROXIMATION IS MADE IN "IFPACK_TEKDEC".
C
    	DATA FT / 1024.0 /		! THIS IS 2**10

     	DEC = FCT
    	IF( FLOAT(INT(DEC)).NE.DEC ) DEC = FLOAT(INT(DEC*FT))/FT
     	IFPACK_DECTEK = DEC

    	RETURN
    	END

    	FUNCTION IFPACK_INTTEK( BUFFER )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, NOV-18,1987
C
C	THIS ROUTINE DECODES AN INTEGER REPORT AND RETURNS
C	AS THE FUNCTION VALUE THE VALUE OF THE INTEGER.
C
C	BUFFER -- 3 BYTE BUFFER CONTAINING THE REPORT
C
    	BYTE BUFFER(3)
    	IHI = BUFFER(1) - 32
    	IHJ = BUFFER(2) - 32
    	ILI = BUFFER(3) - 32
    	IT  = IHI*1024 + IHJ*16 + ILI-16*(ILI/16)
    	ILI = ILI/16
    	ILI = ILI - 2*(ILI/2)
    	IF( ILI.EQ.0 ) IT = -IT
     	IFPACK_INTTEK = IT
    	RETURN
    	END

     	SUBROUTINE IFPLOT( XOP, YOP, IPF )
C
C  PROGRAMMER: R.S. ZHOU,	SEP-1986
C
C    	IPF =  2: DRAW TO (XOP,YOP)
C	IPF =  3: MOVE TO (XOP,YOP)
C	IPF = -3: REORIGIN AND MOVE TO (XOP,YOP)
C	IPF = -9: REORIGIN TO (XOP,YOP) ONLY
C
    	INCLUDE 'TEKLIB.CBS'
	SAVE IPP
C
C  START NEW PANEL UPON PEN-DOWN FOR POLYGON FILL...
C
    	IPN = IABS(IPF)
     	IF( ITM.EQ.1 .OR. IFP.EQ.0 .OR. IPN.EQ.9 ) GOTO 111
     	IF( IPP.EQ.3 .AND. IPN.EQ.2 ) THEN
     	    IF( IFF.EQ.0 ) THEN
     		IFF = 1
     		CALL IFFILL_INIT(1)
     	    ELSE
     		IF( NEW.NE.0 ) CALL IFFILL_INIT(1)
     	    ENDIF
     	ENDIF
C
C  CONVERT COORDINATES TO ABSOLUTE PLOTTER UNITS...
C
111	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    XPS = XOP*XCTH-YOP*YSTH
     	    YPS = XOP*XSTH+YOP*YCTH
     	ELSE
     	    XPS = XOP
     	    YPS = YOP
     	ENDIF
     	XPS = XPS*XSCL + XORS
     	YPS = YPS*YSCL + YORS
     	IF( IPN.EQ.9 ) GOTO 888
     	IXL = IXO+INT(FUNI*XPS)
     	IYL = IYO+INT(FUNI*YPS)
     	IF( IXL.LT.  0 ) IXL = 0
     	IF( IXL.GT.IXM ) IXL = IXM
     	IF( IYL.LT.  0 ) IYL = 0
     	IF( IYL.GT.IYM ) IYL = IYM
     	IF( ITM.EQ.1 ) GOTO 888
     	IF( ITM.EQ.2 ) THEN			!TEK-4100
C
C  SKIP PEN-UP ACTION IF NEW-PANEL POLYGON FILL IS ACTIVE...
C
     	IF( IPN.EQ.3.AND.IFP.NE.0.AND.IFF.NE.0.AND.NEW.NE.0 ) GOTO 888

     	    IF( IPL.GT.MBS-8 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC
    	    IPB(IPL+2) = 'L'
    	    IPL = IPL + 3
    	    IF( IPN.EQ.2 ) IPB(IPL) = 'G'
    	    IF( IPN.EQ.3 ) IPB(IPL) = 'F'
    	    CALL IFPACK_TEKXY( IXL, IYL )
    	ENDIF

     	IF( ITM.EQ.3 ) THEN			!REGIS
     	    IF( IPL.GT.MBS-12 ) CALL IFINIT_DUMP
    	    IPL = IPL + 1
    	    IF( IPN.EQ.2 ) IPB(IPL) = 'V'
    	    IF( IPN.EQ.3 ) IPB(IPL) = 'P'
    	    IPL = IPL + 1
    	    IPB(IPL) = '['
    	    CALL IFPACK_REGIS( IXL )
    	    IPL = IPL + 1
    	    IPB(IPL) = ','
     	    III = 530-IYL
     	    IF( III.GT.479 ) III = 479
    	    CALL IFPACK_REGIS( III )
    	    IPL = IPL + 1
    	    IPB(IPL) = ']'
    	ENDIF

888	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.EQ.MPPS ) CALL IFPLOT_DUMP
     	    NPPS = NPPS + 1
     	    XPPS(NPPS) = XOP
     	    YPPS(NPPS) = YOP
     	    IPPS(NPPS) = IPF
     	ENDIF
     	IF( IPF.LT.0 ) THEN
     	    XORS = XPS
     	    YORS = YPS
     	ENDIF
	IPP = IPN

999	RETURN
    	END

     	SUBROUTINE IFPLOT_DUMP
C
C	THIS ROUTINE DUMPS THE "PLOT" BUFFER.
C
     	INCLUDE 'TEKLIB.CBS'
     	IF( NPPS.GT.0 ) THEN
     	WRITE(IDF,1) (XPPS(I),YPPS(I),IPPS(I),I=1,NPPS)
 1      FORMAT('PLOT:',9(2F6.3,I2))
     	NPPS = 0
     	ENDIF
     	RETURN
     	END

     	SUBROUTINE IFPLOT_LAST( XPS, YPS )
C
C	THIS ROUTINE REPORTS THE LAST PEN LOCATION
C	RELATIVE TO ACTIVE GRAPH ORIGIN IN INCHES.
C
     	INCLUDE 'TEKLIB.CBS'

     	XPL = XSCL*(FLOAT(IXL-IXO)/FUNI-XORS)
     	YPL = YSCL*(FLOAT(IYL-IYO)/FUNI-YORS)
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    DET = XCTH*YCTH + XSTH*YSTH
     	    XPS = (XPL*YCTH+YPL*YSTH) / DET
     	    YPS = (YPL*XCTH-XPL*XSTH) / DET
     	ELSE
     	    XPS = XPL
     	    YPS = YPL
     	ENDIF

     	RETURN
     	END

     	SUBROUTINE IFPLOT_VECT( XOP, YOP, IPF )
C
C  PROGRAMMER: R.S. ZHOU,	SEP-1986
C
C    	IPF =  2: DRAW TO (XOP,YOP)
C	IPF =  3: MOVE TO (XOP,YOP)
C	IPF = -3: REORIGIN AND MOVE TO (XOP,YOP)
C
    	INCLUDE 'TEKLIB.CBS'
C
C  CONVERT COORDINATES TO ABSOLUTE PLOTTER UNITS...
C
    	IPN = IABS(IPF)
     	XPS = XOP*XSCL + XORS
     	YPS = YOP*YSCL + YORS
     	IXL = IXO+INT(FUNI*XPS)
     	IYL = IYO+INT(FUNI*YPS)
     	IF( IXL.LT.0 ) IXL = 0
     	IF( IYL.LT.0 ) IYL = 0
     	IF( IXL.GT.IXM ) IXL = IXM
     	IF( IYL.GT.IYM ) IYL = IYM
     	IF( ITM.EQ.2 ) THEN			!TEK-4100
     	    IF( IPL.GT.MBS-8 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC
    	    IPB(IPL+2) = 'L'
    	    IPL = IPL + 3
    	    IF( IPN.EQ.2 ) IPB(IPL) = 'G'
    	    IF( IPN.EQ.3 ) IPB(IPL) = 'F'
    	    CALL IFPACK_TEKXY( IXL, IYL )
     	ELSE IF( ITM.EQ.3 ) THEN			!REGIS
     	    IF( IPL.GT.MBS-12 ) CALL IFINIT_DUMP
    	    IPL = IPL + 1
    	    IF( IPN.EQ.2 ) IPB(IPL) = 'V'
    	    IF( IPN.EQ.3 ) IPB(IPL) = 'P'
    	    IPL = IPL + 1
    	    IPB(IPL) = '['
    	    CALL IFPACK_REGIS( IXL )
    	    IPL = IPL + 1
    	    IPB(IPL) = ','
     	    III = 530-IYL
     	    IF( III.GT.479 ) III = 479
    	    CALL IFPACK_REGIS( III )
    	    IPL = IPL + 1
    	    IPB(IPL) = ']'
    	ENDIF
     	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.EQ.MPPS ) CALL IFPLOT_DUMP
     	    NPPS = NPPS + 1
     	    XPPS(NPPS) = XOP
     	    YPPS(NPPS) = YOP
     	    IPPS(NPPS) = IPF
     	ENDIF
     	IF( IPF.LT.0 ) THEN
     	    XORS = XPS
     	    YORS = YPS
     	ENDIF
     	RETURN
    	END

    	SUBROUTINE IFPOLY( NS, XOP, YOP, RAD1, RAD2, ANGLE )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE DRAWS A POLYGON.
C
C	NS --------- NUMBER OF SIDES/EDGES.
C	XOP -------- X-COORDINATE OF THE CENTER IN INCHES.
C	YOP -------- Y-COORDINATE OF THE CENTER IN INCHES.
C	RAD1 ------- DIAMETER OF POLYGON IN INCHES.
C	RAD2 ------- BORDER WIDTH (INWARD) IN INCHES.
C	ANGLE ------ ROTATION ANGLE OF OBJECT IN DEGREES FROM X-AXIS.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( ABS(RAD1).LT.0.05 ) RETURN
     	IWD = IDW
     	IF( ITM.EQ.1 ) GOTO 888
C
C  INITIALIZE...
C
     	IDW = 0
     	NSD = NS
     	IF( NSD.LT.3 ) NSD = 3
     	XPS = XOP
     	YPS = YOP
     	RAD = 0.5*ABS(RAD1)
     	WID = ABS(RAD2)
     	IF( WID.GE.RAD ) WID = 0.0
     	ANG = AMOD( ANGLE, 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	CALL IFPLOT( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( ANG.NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ANG+XANG, ANG+YANG )
     	ENDIF
C
C  START THE DRAWING...
C
111	CALL IFPLOT( 0.0, RAD, 3 )
     	ANGC = 360.0/NSD
     	DO  I = 1, NSD
     	    XPS = RAD*COSD(I*ANGC+90.0)
     	    YPS = RAD*SIND(I*ANGC+90.0)
     	    CALL IFPLOT( XPS, YPS, 2 )
     	ENDDO
     	IF( WID.EQ.0.0 ) GOTO 222
     	RAD = RAD - WID/COSD(0.5*ANGC)
     	WID = 0.0
     	GOTO 111
C
C  RESTORE...
C
222	IF( ANG.NE.0.0 ) CALL IFROTA( ANGX, ANGY )
     	CALL IFPLOT( -XOP, -YOP, -9 )

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) NS, RAD1,RAD2, XOP,YOP,ANGLE
     	ENDIF
1000	FORMAT('POLY:',I3,5F8.3)
     	IDW = IWD

999	RETURN
    	END
     	SUBROUTINE IFQAST_CTRLY
C
C  PROGRAMMER:  R.S. ZHOU
C		BOSTON COLLEGE, 1/89
C
C	THIS ROUTINE QUEUES AN ASYNCHRONOUS SYSTEM TRAP (AST)
C	FOR "CTRL_Y" INTERRUPT.
C
     	INCLUDE  'TEKLIB.CBS'
     	INCLUDE  '($IODEF)'
     	INTEGER   CODE
     	EXTERNAL  IFQAST_DCTRLY
C
C  DISABLE DCL DETECTION OF CTRL_Y ...
C
     	MASK = 2**25
     	CALL LIB$DISABLE_CTRL( %REF(MASK) )
C
C  OPEN INPUT CHANNEL FOR TERMINAL...
C
     	CALL SYS$ASSIGN( 'SYS$INPUT', %REF(MASK), , )
C
C  QUEUE THE AST...
C
     	CODE = IO$_SETMODE .OR. IO$M_CTRLYAST
     	CALL SYS$QIOW( , %VAL(MASK), %VAL(CODE),
     +  , , , IFQAST_DCTRLY, , , , , )

     	RETURN
     	END

     	SUBROUTINE IFQAST_DCTRLY
C
C	THIS ROUTINE DELIVERS AN AST FOR "CTRL_Y" INTERRUPT
C	TO CLEAN UP GRAPHICS TERMINAL AND THEN EXIT.
C
C	NEW OUTPUT CHANNEL IS NEEDED TO AVOID RECURSIVE I/O.
C
     	INCLUDE 'TEKLIB.CBS'

     	LUN = 51
    	OPEN( UNIT=LUN, FILE='SYS$OUTPUT', STATUS='NEW',
     +        FORM='FORMATTED', CARRIAGECONTROL='NONE' )
     	IPL = IPK          !ERASE GRAPHICS BUFFER
     	CALL IFINIT_EXIT
     	CALL EXIT
     	END

     	SUBROUTINE IFQAST_CTRLC
C
C	THIS ROUTINE QUEUES AN ASYNCHRONOUS SYSTEM TRAP (AST)
C	FOR "CTRL_C" INTERRUPT.
C
     	INCLUDE  'TEKLIB.CBS'
     	INCLUDE  '($IODEF)'
     	INTEGER   CODE
     	EXTERNAL  IFQAST_DCTRLC
C
C  OPEN INPUT CHANNEL FOR TERMINAL...
C
     	CALL SYS$ASSIGN( 'SYS$INPUT', %REF(NCC), , )
C
C  QUEUE THE AST...
C
     	CODE = IO$_SETMODE .OR. IO$M_CTRLCAST
     	CALL SYS$QIOW( , %VAL(NCC), %VAL(CODE),
     +  , , , IFQAST_DCTRLC, , , , , )
C
C  CLEAR THE FLAG...
C
     	CTRL_C = .FALSE.
     	RETURN
     	END

     	SUBROUTINE IFQAST_DCTRLC
C
C	THIS ROUTINE DELIVERS AN AST FOR "CTRL_C" INTERRUPT.
C	"CTRL_C" FLAG IS MONITORED IN FOLLOWING SUBROUTINES
C	IN TEKLIB:
C
C	IFINIT_PLOT_END --- PLOT SESSION TERMINATION.
C	IFINIT_DUMP ------- GRAPHICS BUFFER DUMP.
C	IFLINE ------------ POLYLINE DRAWING.
C	IFAXIS ------------ AXIS DRAWING.
C	IFFILL ------------ AREA FILLING.
C
C	SO THAT A USER CAN ABORT A PLOT AND STILL GET BACK
C	TO THE DIALOGUE MENU.
C
     	INCLUDE 'TEKLIB.CBS'

     	CTRL_C = .TRUE.
     	IPL = IPK          !ERASE GRAPHICS BUFFER
     	RETURN
     	END

     	LOGICAL FUNCTION IFCTRL_C()
C
C	THIS ROUTINE REPORTS THE "CTRL_C" FLAG.
C
     	INCLUDE 'TEKLIB.CBS'
     	IFCTRL_C = CTRL_C
     	RETURN
     	END

     	SUBROUTINE IFQAST_CLEAR
C
C	THIS ROUTINE CLEARS THE "CTRL_C" FLAG.
C
     	INCLUDE 'TEKLIB.CBS'

     	IF( .NOT.CTRL_C ) THEN
     	    CALL SYS$DASSGN( %VAL(NCC) )
     	ELSE
     	    CTRL_C = .FALSE.
     	ENDIF

     	RETURN
     	END

     	FUNCTION IFQIOW( NCHS, DATA )
C
C  PROGRAMMER:  R.S. ZHOU
C		BOSTON COLLEGE, JANUARY, 1989
C
C	THIS ROUTINE PERFORMS A QIOW.
C
C	IFQIOW = ASCII VALUE OF THE 1ST TERMINATOR CHARACTER.
C	IF IFQIOW.EQ.13, DATA = INPUT STRING.
C	IF IFQIOW.NE.13, DATA = TERMINATOR STRING.
C	NCHS = SIZE OF DATA.
C
     	INCLUDE  '($IODEF)'
     	INTEGER*2 STAT(4)
     	CHARACTER TEXT*164, DATA*(*)

     	DATA = ' '
     	ICODE = IO$_READVBLK .OR. IO$M_ESCAPE
     	CALL SYS$ASSIGN( 'SYS$INPUT', IC, , )
  111	TEXT = ' '
     	CALL SYS$QIOW( , %VAL(IC), %VAL(ICODE), STAT,,,
     +                   %REF(TEXT), %VAL(132),,,,,, )
C
C	STAT(1) = IO STATUS.
C	STAT(2) = OFFSET OF TERMINATOR STRING.
C	STAT(3) = FIRST TERMINATOR CHARACTER.
C	STAT(4) = SIZE OF TERMINATOR STRING.
C
     	IF( STAT(1).NE.1 ) GOTO 111	!IO ERROR
     	CALL SYS$DASSGN( %VAL(IC) )
     	IO = STAT(2)
     	IC = STAT(3)
     	IS = STAT(4)
     	IF( IC.NE.13 ) THEN
     	    IF(IS.GT.1) DATA=TEXT(IO+2:IO+IS)	!TERMINATOR STRING
     	    NCHS = IS-1
     	ELSE
     	    IF(IO.GT.0) DATA=TEXT(1:IO)		!INPUT STRING
     	    NCHS = IO
     	ENDIF
     	IFQIOW = IC
     	RETURN
     	END

     	SUBROUTINE IFQIOW_KEY( KEY )
C
C	THIS ROUTINE READS A SINGLE KEY STROKE.
C	ANSI KEYPAD ESCAPE SEQUENCES ARE RETURNED AS THE
C	NEGATIVES OF THE ASCII CODES OF THE LAST CHARACTERS.
C
     	INCLUDE  '($IODEF)'
     	INTEGER*2 STAT(4)
     	CHARACTER TEXT*16

     	TEXT = ' '
     	ICODE = IO$_READVBLK .OR. IO$M_ESCAPE .OR. IO$M_NOECHO
     	CALL SYS$ASSIGN( 'SYS$INPUT', IC, , )
     	CALL SYS$QIOW( , %VAL(IC), %VAL(ICODE), STAT,,,
     +                   %REF(TEXT), %VAL(1),,,,,, )
C
C	STAT(1) = IO STATUS.
C	STAT(2) = OFFSET OF TERMINATOR STRING.
C	STAT(3) = FIRST TERMINATOR CHARACTER.
C	STAT(4) = SIZE OF TERMINATOR STRING.
C
     	IF( STAT(3).NE.0 ) THEN
     	    KEY = STAT(3)
     	ELSE IF( ICHAR(TEXT(1:1)).EQ.27 ) THEN
     	    TEXT = ' '
     	    CALL SYS$QIOW( , %VAL(IC), %VAL(ICODE), STAT,,,
     +                       %REF(TEXT), %VAL(2),,,,,, )
     	    KEY = -ICHAR(TEXT(2:2))
     	ELSE
     	    KEY = ICHAR(TEXT(1:1))
     	    IF( KEY.GT.96 .AND. KEY.LT.123 ) KEY = KEY-32
     	ENDIF
     	CALL SYS$DASSGN( %VAL(IC) )
     	RETURN
     	END

    	SUBROUTINE IFROTA( ANGX, ANGY )
C
C  PROGRAMMER: R.S. ZHOU	ALFRED UNIVERISTY, DEC-1985
C
C  	THIS ROUTINE SETS THE REFERENCE ROTATION OF X,Y AXES.
C
C  	ANGX ---- ROTATION ANGLE IN DEGREES OF X-AXIS FROM HORIZONTAL.
C  	ANGY ---- ROTATION ANGLE IN DEGREES OF Y-AXIS FROM VERTICAL.
C
    	INCLUDE 'TEKLIB.CBS'

    	XANG = AMOD( ANGX, 360.0 )
    	YANG = AMOD( ANGY, 360.0 )
    	XCTH = COSD( XANG )
    	XSTH = SIND( XANG )
    	YCTH = COSD( YANG )
    	YSTH = SIND( YANG )

     	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) XANG, YANG
     	ENDIF
1000	FORMAT('ROTA:',2F8.3)

999	RETURN
    	END

     	SUBROUTINE IFROTA_NOW( ANGX, ANGY )
C
C	THIS ROUITNE REPORTS CURRENT GRAPH ROTATIONS IN ANGX,ANGY
C
     	INCLUDE 'TEKLIB.CBS'

     	ANGX = XANG
     	ANGY = YANG

999	RETURN
     	END

    	REAL*4 FUNCTION IFROTA_DIST( X1, Y1, X2, Y2 )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERISTY, DEC-1985
C
C  	THIS ROUTINE CALCULATES THE ABSOLUTE DISTANCE
C	BETWEEN TWO POINTS WITH COORDINATES THAT MAY
C	NOT BE IN NORMAL CARTESIAN COORDINATE SYSTEM.
C
    	INCLUDE 'TEKLIB.CBS'

     	X11 = X1*XCTH - Y1*YSTH
     	Y11 = X1*XSTH - Y1*YCTH
     	X22 = X2*XCTH - Y2*YSTH
     	Y22 = X2*XSTH - Y2*YCTH
     	IFROTA_DIST = SQRT( (X22-X11)**2 + (Y22-Y11)**2 )

    	RETURN
    	END

    	SUBROUTINE IFSCAL( XFAC, YFAC )
C
C	THIS ROUTINE SETS THE OVERALL PLOT SCALE FACTORS.
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( XFAC.NE.0.0 ) XSCL = XFAC
    	IF( YFAC.NE.0.0 ) YSCL = YFAC
     	RETURN
    	END

    	SUBROUTINE IFSCAL_NOW( XFAC, YFAC )
C
C   THIS ROUTINE REPORTS THE CURRENT SCALE FACTORS IN XFAC,YFAC.
C
    	INCLUDE 'TEKLIB.CBS'
    	XFAC = XSCL
    	YFAC = YSCL
     	RETURN
    	END

    	SUBROUTINE IFSEG_BLINK( NSG )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINES TURNS ON( NSG>0 ) OR TURNS OFF( NSG<0 ) THE
C	BLINKING OF A SEGMENT "NSG" ON TEK-4100 SERIES TERMINALS.
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT....
C
    	IF( IPL.GT.MBS-7 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 'H'
    	IPL = IPL + 3
     	III = IFSEG_NUMBER(NSG)
    	CALL IFPACK_TEKINT(III)
    	IPL = IPL + 1
    	IF( NSG.GT.0 ) IPB(IPL) = '1'
    	IF( NSG.LT.0 ) IPB(IPL) = '0'

    	RETURN
    	END

    	SUBROUTINE IFSEG_MOVE( NSG, XAD, YAD )
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE MOVES AN EXISTING GRAPH SEGMENT FROM
C	ITS CURRENT POSITION BY "XAD" AND "YAD"
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  GET THE ABSOLUTE SCREEN ADDRESS...
C
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    XPS = XAD*XCTH-YAD*YSTH
    	    YPS = XAD*XSTH+YAD*YCTH
     	ELSE
     	    XPS = XAD
     	    YPS = YAD
     	ENDIF
     	IXA = IXO + INT(FUNI*(XORS+XSCL*XPS))
    	IYA = IYO + INT(FUNI*(YORS+YSCL*YPS))
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-11 ) CALL IFINIT_DUMP
C
C  SET SEGMENT POSITION: <ESC>SX seg-number x-y coords
C
    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 'X'
    	IPL = IPL + 3
     	III = IFSEG_NUMBER(NSG)
    	CALL IFPACK_TEKINT(III)			!pack the segment number
    	CALL IFPACK_TEKXY( IXA, IYA ) 		!pack the position

    	RETURN
    	END

    	SUBROUTINE IFSEG_OPEN( ICODE )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE DOES THE FOLLOWINGS:
C
C	ICODE =999999: DELETE ALL SEGMENTS FROM THE MEMERY
C	ICODE = 0 : CLOSE THE CURRENT GRAPH SEGMENT
C	ICODE > 0 : OPEN A NEW GRAPH SEGMENT OF NUMBER "ICODE"
C	ICODE < 0 : DELETE A GRAPH SEGMENT OF NUMBER "ICODE"
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN

    	ICD = ICODE
    	IF( ICD.EQ.0 ) THEN			!CLOSE THE SEGMENT
    	    IF( IPL.GT.MBS-3 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC			!<ESC>SC
    	    IPB(IPL+2) = 'S'
    	    IPB(IPL+3) = 'C'
    	    IPL = IPL + 3
    	ENDIF
    	IF( ICD.GT.0 .AND. ICD.LT.999999 ) THEN	!OPEN A NEW SEGMENT
    	    IF( IPL.GT.MBS-6 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC			!<ESC>SO segment-number
    	    IPB(IPL+2) = 'S'
    	    IPB(IPL+3) = 'O'
    	    IPL = IPL + 3
     	    III = IFSEG_NUMBER(ICD)
    	    CALL IFPACK_TEKINT(III)
    	ENDIF
    	IF( ICD.LT.0 ) THEN			!DELETE A SEGEMENT
    	    IF( IPL.GT.MBS-6 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC			!<ESC>SK segment-number
    	    IPB(IPL+2) = 'S'
    	    IPB(IPL+3) = 'K'
    	    IPL = IPL + 3
     	    III = IFSEG_NUMBER(ICD)
    	    CALL IFPACK_TEKINT(III)
    	ENDIF
    	IF( ICD.EQ.999999 ) THEN		!DELETE ALL SEGMENTS
    	    IF( IPL.GT.MBS-10 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC			!DELETE THE CURRENT VIEW
    	    IPB(IPL+2) = 'R'
    	    IPB(IPL+3) = 'K'
    	    IPB(IPL+4) = '0'
    	    IPB(IPL+5) = ESC			!DELETE ALL SEGMENTS
    	    IPB(IPL+6) = 'S'
    	    IPB(IPL+7) = 'K'
    	    IPL = IPL + 7
    	    CALL IFPACK_TEKINT( -1 )
    	ENDIF

    	RETURN
    	END

    	SUBROUTINE IFSEG_RENAME( NOLD, NNEW )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE RENUMBERS AN EXISTING GRAPH SEGMENT
C	FROM "NOLD" TO "NNEW".
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.NE.2 .OR. NOLD.EQ.NNEW ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-9 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC		!<ESC>SR old-number new-number
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 'R'
    	IPL = IPL + 3
     	III = IFSEG_NUMBER(NOLD)
    	CALL IFPACK_TEKINT( III)
     	III = IFSEG_NUMBER(NNEW)
    	CALL IFPACK_TEKINT( III)

    	RETURN
    	END

    	SUBROUTINE IFSEG_TRAN( NSEG, XAD,YAD, ANGLE, XFT, YFT )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE TRANSFORMS A GRAPH SEGMENT OF NUMBER "NSEG"
C	BY "XAD" AND "YAD" WITH A ROTATION SPECIFIED BY "ANGLE"
C	IN DEGREE VIA TEK-4100 COMMANDS.
C
C	XFT, YFT --- SCALE FACTORS IN X,Y DIMENSIONS
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  GET THE ABSOLUTE SCREEN ADDRESS...
C
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    XPS = XAD*XCTH-YAD*YSTH
    	    YPS = XAD*XSTH+YAD*YCTH
     	ELSE
     	    XPS = XAD
     	    YPS = YAD
     	ENDIF
     	IXA = IXO + INT(FUNI*(XORS+XSCL*XPS))
    	IYA = IYO + INT(FUNI*(YORS+YSCL*YPS))
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-29 ) CALL IFINIT_DUMP
C
C  SET SEGMENT IMAGE TRANSFORM:
C  <ESC>SI segment-number x-scale-factor
C  y-scale-factor rotation-angle postion
C
    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 'I'
    	IPL = IPL + 3
     	III = IFSEG_NUMBER(NSEG)
    	CALL IFPACK_TEKINT( III     )	!pack the segment number
    	CALL IFPACK_TEKDEC( XFT     )	!pack the x-scale factor
    	CALL IFPACK_TEKDEC( YFT     )	!pack the y-scale factor
    	CALL IFPACK_TEKDEC( ANGLE   )	!pack the rotation angle
    	CALL IFPACK_TEKXY ( IXA,IYA ) 	!pack the position

    	RETURN
    	END

    	SUBROUTINE IFSEG_HIDE( NSG )
C
C  PROGRAMMER: R.S. ZHOU		JUNE-1986
C
C	THIS ROUTINES SETS THE VISIBILITY OF A SEGMENT "NSG":
C		NSG<0: INVISIBLE
C		NSG>0: VISIBLE
C	ON TEK-4100 SERIES TERMINALS.
C
    	INCLUDE 'TEKLIB.CBS'

     	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  IF BUFFER IS FULL, DUMP IT....
C
    	IF( IPL.GT.MBS-7 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 'V'
    	IPL = IPL + 3
     	III = IFSEG_NUMBER(NSG)
    	CALL IFPACK_TEKINT(III)
    	IPL = IPL + 1
    	IF( NSG.LT.0 ) IPB(IPL) = '0'
    	IF( NSG.GT.0 ) IPB(IPL) = '1'

    	RETURN
    	END

    	SUBROUTINE IFSEG_PIVOT( XAD, YAD )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE SETS THE PIVOT FOR THE SUBSEQUENT
C	DEFINITION OF A GRAPH SEGMENT VIA TEK-4100 COMMANDS.
C
    	INCLUDE 'TEKLIB.CBS'

    	IF( CTRL_C .OR. ITM.NE.2 ) RETURN
C
C  GET THE ABSOLUTE SCREEN ADDRESS...
C
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    XPS = XAD*XCTH-YAD*YSTH
    	    YPS = XAD*XSTH+YAD*YCTH
     	ELSE
     	    XPS = XAD
     	    YPS = YAD
     	ENDIF
     	IXA = IXO + INT(FUNI*(XORS+XSCL*XPS))
    	IYA = IYO + INT(FUNI*(YORS+YSCL*YPS))
C
C  IF BUFFER IS FULL, DUMP IT...
C
    	IF( IPL.GT.MBS-8 ) CALL IFINIT_DUMP

    	IPB(IPL+1) = ESC		!<ESC>SP position
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 'P'
    	IPL = IPL + 3
    	CALL IFPACK_TEKXY( IXA, IYA )

    	RETURN
    	END

     	FUNCTION IFSEG_NUMBER( IS )
     	INCLUDE 'TEKLIB.CBS'
     	NS = IABS(IS)
     	IF( NS.GT.100 ) NS = NS + 5000*NSE
     	IFSEG_NUMBER = NS
     	RETURN
     	END

     	SUBROUTINE IFSPEN( IPEN )
C
C  PROGRAMMER: R.S. ZHOU	SEP-1986
C
C  	THIS ROUTINE SETS ACTIVE COLOR TEXT-INDEX AND LINE-INDEX.
C
	INCLUDE 'TEKLIB.CBS'

     	IPN = IABS(IPEN)
     	IF( IPN.LT.0 .OR. IPN.GT.7 ) IPN = 1
     	IF( IPN.EQ.ILP ) RETURN

     	IF( ITM.EQ.1 ) GOTO 888
C
C  SET THE WRITING COLOR...
C
     	IF( ITM.EQ.2 ) THEN		!TEK-4100 GRAPHICS
     	    IF( IPL.GT.MBS-8 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC		!<ESC>ML index: LINE INDEX
    	    IPB(IPL+2) = 'M'
    	    IPB(IPL+3) = 'L'
    	    IPB(IPL+4) = 48 + IPN
    	    IPL = IPL + 4
    	    IPB(IPL+1) = ESC		!<ESC>MT index: TEXT INDEX
    	    IPB(IPL+2) = 'M'
    	    IPB(IPL+3) = 'T'
    	    IPB(IPL+4) = 48 + IPN
    	    IPL = IPL + 4
    	ENDIF

    	IF( ITM.EQ.3 ) THEN		!REGIS GRAPHICS
     	    IF( IPL.GT.MBS-5 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = 'W'
    	    IPB(IPL+2) = '('
    	    IPB(IPL+3) = 'I'
    	    IF( IPN.EQ.1 ) IPB(IPL+4) = '7'
    	    IF( IPN.GT.1 ) IPB(IPL+4) = 47 + IPN
    	    IPB(IPL+5) = ')'
    	    IPL = IPL + 5
    	ENDIF

888	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) IPEN
     	ENDIF
1000	FORMAT('SPEN:',I3)
     	ILP = IPN			!SAVE THE CURRENT PEN

999	RETURN
    	END

     	SUBROUTINE IFSPEN_NOW( IPEN )
C
C	THIS ROUTINE REPORTS THE CURRENT PEN NUMBER IN "IPEN".
C
     	INCLUDE 'TEKLIB.CBS'

     	IPEN = ILP

999	RETURN
     	END

	SUBROUTINE IFSTYL( LTYP, LWID )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY,  JAN-1988
C
C	THIS ROUTINE SETS ACTIVE PLOTTING STYLUS
C	FOR SUBSEQUENT VECTOR GENERATIONS.
C
C	LTYP: ACTIVE LINE TYPE.
C
C		LTYP = 1: SOLID
C		LTYP = 2: DOTTED
C		LTYP = 3: 1 DOT CENTER
C		LTYP = 4: SHORT DASH
C		LTYP = 5: MEDIUM DASH
C		LTYP = 6: 3 DOT CENTER
C		LTYP = 7: LONG AND SHORT DASH
C		LTYP = 8: SPARSE DASH
C
C	LWID: ACTIVE LINE WIDTH NUMBER (NOT IMPLEMENTED ON CRT).
C
	INCLUDE 'TEKLIB.CBS'
     	CHARACTER PATTERN*8

     	IF( LTY.EQ.LTYP .AND. LWD.EQ.LWID ) RETURN
     	IF( IABS(LTYP).GT.0 ) THEN
     	    LTY = IABS(LTYP)
     	    IF( LTY.GT.8 ) LTY = 8
     	ENDIF
     	IF( IABS(LWID).GT.0 ) THEN
     	    LWD = IABS(LWID)
     	    IF( LWD.GT.9 ) LWD = 9
     	ENDIF
     	IF( ITM.EQ.2 ) THEN		!TEK-4100 GRAPHICS
     	    IF( IPL.GT.MBS-8 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC		!<ESC>MV index: LINE-TYPE
    	    IPB(IPL+2) = 'M'
    	    IPB(IPL+3) = 'V'
    	    IPB(IPL+4) = 47 + LTY
    	    IPL = IPL + 4
     	ENDIF
    	IF( ITM.EQ.3 ) THEN		!REGIS GRAPHICS
     	    IF( IPL.GT.MBS-12 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = 'W'
    	    IPB(IPL+2) = '('
    	    IPB(IPL+3) = 'P'
     	    IPL = IPL + 3
     	    IF( LTY.EQ.1 ) THEN
     		PATTERN = '11111111'
     	    ELSE IF( LTY.EQ.2 ) THEN
     		PATTERN = '10001000'
     	    ELSE IF( LTY.EQ.3 ) THEN
     		PATTERN = '11100100'
     	    ELSE IF( LTY.EQ.4 ) THEN
     		PATTERN = '11110000'
     	    ELSE IF( LTY.EQ.5 ) THEN
     		PATTERN = '11111100'
     	    ELSE
     		PATTERN = '11000100'
     	    ENDIF
     	    DO  I=1, 8
     		IPL = IPL + 1
     		IPB(IPL) = ICHAR(PATTERN(I:I))
     	    ENDDO
    	    IPL = IPL + 1
    	    IPB(IPL) = ')'
    	ENDIF

     	IF( IDW.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    WRITE(IDF,1000) LTYP,LWID
     	ENDIF
1000	FORMAT('STYL:',2I3)

999	RETURN
	END

     	SUBROUTINE IFSTYL_NOW( LTYP, LWID )
C
C	THIS ROUTINE REPORTS THE ACTIVE LINE TYPE AND LINE WIDTH.
C
     	INCLUDE 'TEKLIB.CBS'

     	LTYP = LTY
     	LWID = LWD

     	RETURN
     	END
    	SUBROUTINE IFTEXT( XOP,YOP,TEXT,WIDTH,HEIGHT,ANGLE )
C
C  PROGRAMMER: R.S. ZHOU	FEB-1986
C
C	THIS ROUTINE HANDLES GRAPHTEXT GENERATION.
C
C	XOP,YOP --- STARTING POSITION FOR DRAWING
C	TEXT    --- TEXT IN CHARACTER FORMAT
C	WIDTH   --- WIDTH OF TEXT IN INCHES
C	HEIGHT  --- HEIGHT OF TEXT IN INCHES
C	ANGLE   --- TEXT STRING SLANT ANGLES IN DEGREES
C
    	INCLUDE		'TEKLIB.CBS'
    	CHARACTER	TEXT*(*)
     	LOGICAL		BOLDFACE
    	DIMENSION	CSIZ(17)
C
C  'CSIZ' CONTAINS THE ACTUAL SIZES OF REGIS CHARACTER SET.
C  THUS, THESE ARE THE ONLY ALLOWABLE CHARACTER HEIGHTS.
C
    	DATA CSIZ/0.10,0.20,0.25,0.45,0.55,0.75,0.85,1.05,1.15,
    	1 1.35,1.40,1.65,1.80,1.85,2.05,2.25,2.35/

    	NCH = IFMISC_LENG( TEXT )
     	IF( NCH.EQ.0 ) GOTO 999
     	IWD = IDW
     	IDW = 0
     	IF( ITM.EQ.1 ) GOTO 888
     	XPS = XOP
     	YPS = YOP
     	WTH = WIDTH
    	HGT = HEIGHT
    	IAN = AMOD( ANGLE+XANG, 360.0 )
     	BOLDFACE = .FALSE.

    	IF( ITM.NE.2 ) GOTO 444
C
C  SET GRAPHTEXT ROTATION...
C
     	IF( IAN.NE.0 ) THEN
     	    IF( IPL.GT.MBS-7 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC		!<ESC>MR angle
    	    IPB(IPL+2) = 'M'
    	    IPB(IPL+3) = 'R'
    	    IPL = IPL + 3
    	    CALL IFPACK_TEKINT( IAN )
    	    IPL = IPL + 1
    	    IPB(IPL) = '0'
     	ENDIF
C
C  SET GRAPHTEXT SIZE...
C
     	IF( IPL.GT.MBS-12 ) CALL IFINIT_DUMP
     	IPB(IPL+1) = ESC		!<ESC>MC width,height,spacing
     	IPB(IPL+2) = 'M'
     	IPB(IPL+3) = 'C'
     	IPL = IPL + 3
     	CALL IFPACK_TEKINT( INT(FUNI*WTH*0.75*XSCL) )	!CHARACTER CELL WIDTH
     	CALL IFPACK_TEKINT( INT(FUNI*HGT*YSCL)      )	!CHARACTER CELL HEIGHT
     	CALL IFPACK_TEKINT( INT(FUNI*WTH*0.25*XSCL) )	!CHARACTER CELL SPACING
C
C  MOVE TO THE STARTING POINT...
C
111	CALL IFPLOT( XPS, YPS, 3 )
C
C  SEND GRAPHTEXT...
C
     	IF( IPL.GT.NBS-NCH-IPK-6 ) CALL IFINIT_DUMP
    	IPB(IPL+1) = ESC		!<ESC>LT NCH,text
    	IPB(IPL+2) = 'L'
    	IPB(IPL+3) = 'T'
    	IPL = IPL + 3
    	CALL IFPACK_TEKINT( NCH )	!DELIMITER
    	DO I=1, NCH
    	   IPL = IPL + 1
    	   IPB(IPL) = ICHAR( TEXT(I:I) )
    	ENDDO
     	IF( IFN.NE.3 .OR. BOLDFACE ) GOTO 222
     	BOLDFACE = .TRUE.
     	XPS = XPS + 0.015*COSD(FLOAT(IAN))
     	YPS = YPS + 0.015*SIND(FLOAT(IAN))
    	GOTO 111
222	IF( IAN.NE.0 ) THEN
     	    IF( IPL.GT.MBS-7 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = ESC		!<ESC>MR angle
    	    IPB(IPL+2) = 'M'
    	    IPB(IPL+3) = 'R'
    	    IPL = IPL + 3
    	    CALL IFPACK_TEKINT( 0 )
    	    IPL = IPL + 1
    	    IPB(IPL) = '0'
     	ENDIF
     	GOTO 888

444	IF( ITM.NE.3 ) GOTO 888
C
C  PLOT IN REGIS COMMANDS...
C
     	IAN = 45*(IAN/45)
    	WTH = WTH*XSCL
C
C  GET CHARACTER SIZE NUMBER...
C
    	DO K=1, 17
    	   IF( WTH.LE.CSIZ(K) ) GOTO 555
    	ENDDO
     	K = K-1
C
C  MOVE TO THE STARTING POINT...
C
555	XPS = XPS - 1.25*WTH*SIND(FLOAT(IAN))
     	YPS = YPS + 1.25*WTH*COSD(FLOAT(IAN))
     	CALL IFPLOT( XPS, YPS, 3 )

     	IF( IPL.GT.MBS-19 ) CALL IFINIT_DUMP
     	IPB(IPL+1) = 'T'
C
C  THIS IS THE STRING SLANT...
C
     	IPB(IPL+2) = '('
    	IPB(IPL+3) = 'D'
    	IPL = IPL + 3
    	CALL IFPACK_REGIS( IAN )
    	IPL = IPL + 1
    	IPB(IPL) = ')'
C
C  THIS IS THE CHARACTER SIZE...
C
    	IPB(IPL+1) = '('
    	IPB(IPL+2) = 'S'
    	IPB(IPL+3) = 47+K
    	IPB(IPL+4) = ')'
    	IPL = IPL + 4
C
C  THIS IS THE CHARACTER SLANT...
C
     	IPB(IPL+1) = '('
    	IPB(IPL+2) = 'D'
    	IPL = IPL + 2
    	CALL IFPACK_REGIS( IAN )
    	IPL = IPL + 1
    	IPB(IPL) = ')'
C
C  LOAD THE TEXT INTO THE BUFFER USING (") AS DELIMITERS...
C
     	IF( IPL.GT.MBS-2-NCH ) CALL IFINIT_DUMP
    	IPL = IPL + 1
    	IPB(IPL) = '"'
    	DO I=1, NCH
    	   IPL = IPL + 1
    	   IPB(IPL) = ICHAR( TEXT(I:I) )
    	ENDDO
    	IPL = IPL + 1
    	IPB(IPL) = '"'
     	IF( IFN.NE.3 .OR. BOLDFACE ) GOTO 888
     	BOLDFACE = .TRUE.
     	XPS = XPS + 0.015*COSD(FLOAT(IAN))
     	YPS = YPS + 0.015*SIND(FLOAT(IAN))
     	GOTO 555

888	IF( IWD.NE.0 ) THEN
     	    IF( NPPS.GT.0 ) CALL IFPLOT_DUMP
     	    IF( NCH.GT.80 ) NCH = 80
     	    WRITE(IDF,1000) NCH,XOP,YOP,WIDTH,HEIGHT,ANGLE,TEXT(1:NCH)
     	ENDIF
1000	FORMAT('TEXT:',I3,5F8.3,',',A)
     	IDW = IWD
     	IF( ANSI.AND.ANGLE.EQ.0.0.AND.WIDTH.GT.0.08 ) THEN
     	    CALL IFANSI_CHAR(XOP,YOP,NCH,TEXT)
     	ENDIF

999	RETURN
    	END

    	SUBROUTINE IFTEXT_EXT(XO,YO,TEXT,WIDTH,HEIGHT,ANGLE)
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY	JAN-1986
C
C	THIS ROUTINE HANDLES EXTENDED GRAPHTEXT PLOTTING.
C
C	XO,YO  ----  THE STARTING POSITION OF THE TEXT LINE.
C	TEXT   ----  THE TEXT LINE TO BE PLOTTED.
C	WIDTH  ----  THE WIDTH OF THE TEXT LINE.
C	HEIGHT ----  THE HEIGHT OF THE TEXT LINE.
C	ANGLE  ----  THE SLANT ANGLE OF THE TEXT LINE.
C
C---------------------------------------------------------------------
C
C	CONTROLL SEQUENCES THAT CAN BE USED IN THE TEXT:
C
C	"{" --- CONVERT THE NEXT NON-BLANK CHARACTER TO SUPERSCRIPT
C	"}" --- CONVERT THE NEXT NON-BLANK CHARACTER TO SUBSCRIPT
C	\sTEXT_STRING^s  --- SLANT CHARS OF THE TEXT STRING.
C	\bTEXT_STRING^b  --- THE TEXT STRING AS BOLD FACE
C	\#TEXT_STRING^p  --- SET PEN # FOR THE TEXT STRING.
C
C---------------------------------------------------------------------
C
    	CHARACTER SYM*1, TEXT*(*)
     	BYTE      ITT, IFLAG
     	LOGICAL   IBL, IIB, IIS, IIP

    	NCH = IFMISC_LENG( TEXT )
     	IF( NCH.EQ.0 ) RETURN
     	XOP = XO
    	YOP = YO
     	ANG = ANGLE
    	WTH = WIDTH
    	HGT = HEIGHT
     	NCS = IFTEXT_FLAGS( TEXT )
     	IC  = 1
     	IBL = .FALSE.
     	IIB = .FALSE.
     	IIS = .FALSE.
     	IF( NCS.GT.0 ) GOTO 2
C
C  NO FUNCTION FLAGS FOUND...
C
   1	CALL IFTEXT( XOP, YOP, TEXT(IC:), WTH, HGT, ANG )
     	GOTO 999
C
C  INITIALIZATION...
C
   2	IC = 1				! COUNT FOR TRUE TEXT CHAR.!
     	CTH = COSD( ANG )		! ROTATION CORRECTION !
    	STH = SIND( ANG )		! ROTATION CORRECTION !
     	CALL IFSCAL_NOW( XSF,YSF )
     	CALL IFSPEN_NOW( IPO )		! GET THE CURRENT PEN NUMBER
    	IFLAG = 0			! FLAG FOR CONTROLL SEQUENCE
C
C  LOOP THROUGH THE TEXTSTRING CHARACTER BY CHARACTER...
C
   3	IF( IFCTRL_C() ) RETURN
     	XPS = XOP
     	YPS = YOP
     	WWW = WTH
     	HHH = HGT
    	SYM = TEXT(IC:IC)
    	IF( SYM.EQ.' ' ) GOTO 666
     	IBL = .TRUE.
     	IF( SYM.NE.'{' ) GOTO 333
     	IF( TEXT(IC+1:IC+1).EQ.' ' ) GOTO 666
C
C  SUPERSCRIPT...
C
     	IC = IC + 1
     	SYM = TEXT(IC:IC)
     	XPS = XPS-0.7*WWW*STH	! X-OFFSET !
     	YPS = YPS+0.7*HHH*CTH	! Y-OFFSET !
     	WWW = 0.67*WWW
     	HHH = 0.67*HHH
    	GOTO 666

333	IF( SYM.NE.'}' ) GOTO 444
     	IF( TEXT(IC+1:IC+1).EQ.' ' ) GOTO 666
C
C  SUBSCRIPT...
C
     	IC = IC + 1
     	SYM = TEXT(IC:IC)
     	XPS = XPS+0.2*WWW*STH	! X-OFFSET !
     	YPS = YPS-0.2*HHH*CTH	! Y-OFFSET !
     	WWW = 0.67*WWW
     	HHH = 0.67*HHH
    	GOTO 666
C
C  START CONTROL SEQUENCE OF SOME KIND...
C
444	IF( SYM.NE.'\' ) GOTO 555		! NO FLAG !
    	IFLAG = IFLAG + 1
    	IC = IC + 1
    	SYM = TEXT(IC:IC)

     	IF( SYM.EQ.'S' .OR. SYM.EQ.'s' ) THEN
     	    CALL IFFONT( 2 )			!ITALIC FONT
     	    IIS = .TRUE.
     	    GOTO 777
     	ENDIF

     	IF( SYM.EQ.'B' .OR. SYM.NE.'b' ) THEN
     	    CALL IFFONT( 3 )			!BOLDFACE FONT
     	    IIB = .TRUE.
     	    GOTO 777
     	ENDIF
C
C  ATTEMPT TO CHANGE TEXT COLOR...
C
     	READ(SYM,445,ERR=777) NCS
C     	DECODE( 1, 445, SYM, ERR=777 ) NCS
 445	FORMAT(I1)
    	IF( NCS.GT.0 .AND. NCS.LT.9 ) THEN
     	    CALL IFSPEN( NCS )
     	    IIP = .TRUE.
     	ENDIF
    	GOTO 777
C
C  STOP CONTROL SEQUENCE OF SOME KIND...
C
555	IF( SYM.NE.'^' .OR. IFLAG.EQ.0 ) GOTO 666
    	IFLAG = IFLAG -1
    	IC = IC + 1
    	SYM = TEXT(IC:IC)
     	IF( SYM.EQ.'S' .OR. SYM.EQ.'s' ) THEN
     	    CALL IFFONT( 1 )
     	    IIS = .FALSE.
     	    GOTO 777
     	ENDIF
     	IF( SYM.EQ.'B' .OR. SYM.EQ.'b' ) THEN
     	    CALL IFFONT( 1 )
     	    IIB = .FALSE.
     	    GOTO 777
     	ENDIF
     	IF( SYM.EQ.'P' .OR. SYM.EQ.'p' ) THEN
     	    CALL IFSPEN(IPO)
     	    IIP = .FALSE.
     	ENDIF
     	GOTO 777
C
C  DRAW THE CHARACTER...
C
666	IF(IBL) CALL IFTEXT( XPS, YPS, SYM, WWW, HHH, ANG )
C
C  UPDATE X,Y COORDINATES...
C
     	XOP = XOP + WTH*CTH
     	YOP = YOP + WTH*STH*XSF/YSF
C
C  GET THE NEXT CHARACTER...
C
777	IF( IC.GE.NCH ) GOTO 999
     	IC = IC + 1
     	NCS = IFTEXT_FLAGS( TEXT(IC:) )
     	IF( NCS.EQ.0 ) GOTO 1	!NO MORE CONTROLL SEQUENCE LEFT
     	GOTO 3
C
C  READY TO GET OUT...
C
999	IF( IIP ) CALL IFSPEN( IPO )
    	IF( IIB .OR. IIS ) CALL IFFONT( 1 )

     	RETURN
    	END

     	FUNCTION IFTEXT_FLAGS( TEXT )

	CHARACTER FLAGS(4)*1, TEXT*(*)
     	DATA FLAGS / '{', '}', '\', '^' /

     	K = IFMISC_LENG( TEXT )
	DO I= 1, K
     	   DO J=1, 4
     	      IF( TEXT(I:I) .EQ. FLAGS(J) ) GOTO 1
     	   ENDDO
     	ENDDO
     	IFTEXT_FLAGS = 0
     	RETURN
  1	IFTEXT_FLAGS = 1
     	RETURN
     	END

    	SUBROUTINE IFTEXT_MARK( XOP, YOP, HEIGHT, TEXT, ANGLE, NCHAR )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, MAY-1987
C
C	THIS ROUTINE IS HERE ONLY FOR CALCOMP CALL COMPATIBILITY
C
C	XOP,YOP --- STARTING POSITION FOR DRAWING
C	HEIGHT  --- HEIGHT OF TEXT IN INCHES
C	TEXT    --- TEXT IN CHARACTER FORMAT
C	ANGLE   --- TEXT STRING SLANT ANGLES IN DEGREES
C	NCHAR   --- NUMBER OF TEXT CHARACTERS TO BE PLOTTED
C
     	CHARACTER TEXT*(*)

     	NCH = NCHAR
     	IF( NCH.GT.0 ) THEN
     	    K = IFMISC_LENG(TEXT)
     	    IF( K.GT.NCH ) TEXT(NCH:) = ' '
     	    CALL IFTEXT_EXT(XOP,YOP,TEXT,HEIGHT,HEIGHT,ANGLE)
     	ELSE
     	    IF( NCH.EQ.-2 ) CALL IFPLOT(XOP,YOP,2)
     	    NCH = ICHAR(TEXT(1:1))
    	    CALL IFMARK(XOP,YOP,HEIGHT,ANGLE,NCH)
     	ENDIF

     	RETURN
    	END

     	SUBROUTINE IFTEXT_FPN( XPS, YPS, SIZE, FNUM, ANGLE, IDIG )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 9/1988
C
C	THIS ROUTINE DISPLAYS A FLOATING POINT NUMBER.
C
C	IDIG: NUMBER OF DIGITS AFTER THE DECIMAL POINTS.
C	IF IDIG.EQ.-1, ONLY THE INTEGER PART IS DISPLAYED.
C
     	CHARACTER TEXT*16

     	WRITE(TEXT,1000) FNUM
C     	ENCODE( 16, 1000, TEXT ) FNUM
1000	FORMAT(F16.6)
     	DO IK= 1, 16
     	   IF( TEXT(IK:IK).NE.' ' ) GOTO 111
     	ENDDO
111	NCH = 10 + IDIG
     	IF( NCH.GT.16 ) NCH = 16
     	CALL IFTEXT( XPS, YPS, TEXT(IK:NCH), SIZE, SIZE, ANGLE )
     	RETURN
     	END

    	SUBROUTINE IFTEXT_CENT( XST,XED,YST,YED,TXT,WTH,HGT )
C
C	PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE CENTERS A TEXTSTRING.
C
C	XST,XED  ---  START AND ENDING X-COORDINATES IN INCHES.
C	YST,YED  ---   "     "    "    Y-     "       "    ".
C	TXT      ---  LABEL IN CHARACTER FORMAT.
C		      IF TXT(1).EQ.'!', TXT IS NOT CENTERED.
C	WTH      ---  WIDTH OF LABEL IN INCHES.
C	HGT      ---  HEIGHT OF LABEL IN INCHES.
C
    	CHARACTER TXT*(*)
    	DATA R2D / 57.29577952 /

     	NK = IFTEXT_STRIP( TXT )
     	IF( NK.EQ.0 ) RETURN
     	DIST = SQRT( (XED-XST)**2 + (YED-YST)**2 )
     	IF( DIST.EQ.0.0 ) RETURN
     	COSTH = (XED-XST) / DIST
     	SINTH = (YED-YST) / DIST
     	WITH  = WTH
     	IF( TXT(1:1).EQ.'!' ) THEN
     	    TXT = TXT(2:)
     	    XPS = XST
     	    YPS = YST
     	ELSE
     	    CALL IFSCAL_NOW( XPS, YPS )
     	    ANGLE = 1.0 + SINTH*(XPS/YPS-1.0)
     	    SPOS = DIST - NK * WITH * ANGLE
    	    IF( SPOS.LT.0.0 ) THEN
    		WITH = DIST / NK / ANGLE
     		IF( WITH.LT.0.05 ) WITH = 0.05
    		SPOS = DIST - NK * WITH * ANGLE
     	    ENDIF
     	    SPOS = 0.5 * SPOS
    	    XPS = XST + SPOS * COSTH
    	    YPS = YST + SPOS * SINTH
     	ENDIF
     	ANGLE = ASIN( SINTH ) * R2D
    	IF( COSTH.LT.0.0 ) ANGLE = 180.0-ANGLE
    	CALL IFTEXT_EXT( XPS, YPS, TXT, WITH, HGT, ANGLE )
     	RETURN
    	END

	FUNCTION IFTEXT_STRIP( TEXT )
C
C	THIS ROUTINE RETURNS THE LENGTH OF "TEXT" STRIPPED OF
C	ALL EMBEDDED CONTROL SEQUENCES ALLOWED IN "IFTEXT_EXT.FOR".
C
     	CHARACTER SYM*1, TEXT*(*)
     	LOGICAL   FLAG

    	NCH = IFMISC_LENG( TEXT )
     	MAX = NCH-1
    	FLAG= .FALSE.
	DO 5 I=1, MAX
    	SYM = TEXT(I:I)
     	IF( SYM.NE.'{' .AND. SYM.NE.'}' ) GOTO 3
     	IF( TEXT(I+1:I+1).EQ.' ' ) GOTO 5
     	NCH = NCH -1
     	GOTO 5
3    	IF( SYM.NE.'\' ) GOTO 4
    	FLAG= .TRUE.
    	NCH = NCH-2
    	GOTO 5
4	IF( SYM.NE.'^' .OR. .NOT.FLAG ) GOTO 5
    	FLAG= .FALSE.
    	NCH = NCH-2
5	CONTINUE
    	IF( NCH.LT.0 ) NCH = 0
    	IFTEXT_STRIP = NCH

    	RETURN
	END

     	FUNCTION IF_DCL_PUT( IMAGE )
C
C  PROGRAMMER: R.S. ZHOU
C		BOSTON COLLEGE, MAY-1989
C
C	THIS ROUTINE PARSES THE DCL LINE DEFINED IN "GRAFIT.CLD".
C
     	CHARACTER IMAGE*(*)
     	CHARACTER BUFFER*252, DAT_FILE(6)*32, CLINE*256, VALUE*64
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	LOGICAL   YES
     	INTEGER   CLI$PRESENT,  CLI$GET_VALUE
     	EXTERNAL  CLI$_NEGATED
     	EQUIVALENCE( BUFFER( 1:), NFUNC  )
     	EQUIVALENCE( BUFFER( 2:), HARDCOPY )
     	EQUIVALENCE( BUFFER( 3:), SKIPDI )
     	EQUIVALENCE( BUFFER( 4:), NFILES )
     	EQUIVALENCE( BUFFER( 5:), IDPLOT )
     	EQUIVALENCE( BUFFER( 6:), HPAGE  )
     	EQUIVALENCE( BUFFER( 7:), DEVICE )
     	EQUIVALENCE( BUFFER( 8:), PAGE_FEED )
     	EQUIVALENCE( BUFFER( 9:), PEN_SPEED )
     	EQUIVALENCE( BUFFER(10:), COPIES )
     	EQUIVALENCE( BUFFER(11:), IDTERM )
     	EQUIVALENCE( BUFFER(21:), MSET   )
     	EQUIVALENCE( BUFFER(25:), MPTS   )
     	EQUIVALENCE( BUFFER(31:), XOFFSET)
     	EQUIVALENCE( BUFFER(35:), YOFFSET)
     	EQUIVALENCE( BUFFER(39:), XSCALE )
     	EQUIVALENCE( BUFFER(43:), YSCALE )
     	EQUIVALENCE( BUFFER(61:), DAT_FILE )
C
C  INITIALIZE...
C
     	CALL IFINIT(1)
     	HARDCOPY = .FALSE.
     	SKIPDI   = .FALSE.
     	IDTERM   = 0
     	NFUNC    = 0
     	MSET     = 0
     	MPTS     = 0
     	NFILES   = 0
     	DO I=1, 6
     	   DAT_FILE(I) = ' '
     	ENDDO
C
C  PARSE THE WHOLE INPUT LINE FIRST...
C
     	CALL CLI$GET_VALUE('$LINE',CLINE,NCLINE)
     	IF( CLINE(1:NCLINE).EQ.'GRAFIT') GOTO 999
     	ISP = INDEX(CLINE(1:NCLINE),' ')
     	ISL = INDEX(CLINE(1:NCLINE),'/')
     	IF( ISP.EQ.0 .AND. ISL.EQ.0 ) GOTO 999
     	JSL = ISL
     	IF( ISP.GT.0 ) THEN
     	    ISL = INDEX('RUN',CLINE(1:ISP-1))
     	    IF( ISL.GT.0 ) GOTO 999
     	ENDIF
     	IF( JSL.EQ.0 ) GOTO 444
C
C  PARSE GRAPHICS FUNCTION...
C
     	ISL = INDEX( CLINE(1:NCLINE), '/F' )
     	IF( ISL.EQ.0 ) GOTO 111
     	IF( CLI$PRESENT('FUNCTION')
     +.AND. CLI$GET_VALUE('FUNCTION',VALUE,N) ) THEN
     	    IF( VALUE(1:2).EQ.'XY' ) THEN
     		NFUNC = 1
     	    ELSE IF( VALUE(1:2).EQ.'LA' ) THEN
     		NFUNC = 2
     	    ELSE IF( VALUE(1:2).EQ.'CO' ) THEN
     		NFUNC = 3
     	    ELSE IF( VALUE(1:2).EQ.'HI' ) THEN
     		NFUNC = 4
     	    ELSE IF( VALUE(1:2).EQ.'PI' ) THEN
     		NFUNC = 5
     	    ELSE IF( VALUE(1:2).EQ.'TE' ) THEN
     		NFUNC = 6
     	    ELSE IF( VALUE(1:2).EQ.'FU' ) THEN
     		NFUNC = 7
     	    ELSE IF( VALUE(1:2).EQ.'DI' ) THEN
     		NFUNC = 8
     	    ELSE IF( VALUE(1:2).EQ.'C3' ) THEN
     		NFUNC = 9
     	    ELSE IF( VALUE(1:2).EQ.'OR' ) THEN
     		NFUNC = 10
     	    ELSE IF( VALUE(1:2).EQ.'ST' ) THEN
     		NFUNC = 11
     	    ELSE IF( VALUE(1:2).EQ.'PL' ) THEN
     		NFUNC = 12
     	    ELSE IF( VALUE(1:2).EQ.'PH' ) THEN
     		NFUNC = 13
     	    ELSE IF( VALUE(1:2).EQ.'LU' ) THEN
     		NFUNC = 14
     	    ELSE IF( VALUE(1:2).EQ.'TO' ) THEN
     		NFUNC = 15
     	    ENDIF
     	ENDIF
C
C  PARSE HARDCOPY MODE...
C
 111	IF( CLI$PRESENT('TERMINAL')
     +.AND. CLI$GET_VALUE('TERMINAL',VALUE,N) ) THEN
     	    IF( VALUE(1:1).EQ.'A' ) THEN
     		IDTERM = 1
     	    ELSE IF( VALUE(1:1).EQ.'T' ) THEN
     		IDTERM = 2
     	    ELSE
     		IDTERM = 3
     	    ENDIF
     	ELSE IF(CLI$PRESENT('HARDCOPY').EQ.%LOC(CLI$_NEGATED)) THEN
     		SKIPDI = .TRUE.
     	ELSE
     	    IF( CLI$PRESENT('HARDCOPY') .OR. CLI$PRESENT('DEVICE')
     +     .OR. CLI$PRESENT('SCALE')    .OR. CLI$PRESENT('OFFSET')
     +     .OR. CLI$PRESENT('HPAGE')    .OR. CLI$PRESENT('VPAGE')
     +     .OR. CLI$PRESENT('PAGE_FEED').OR. CLI$PRESENT('PEN_SPEED')
     +     .OR. CLI$PRESENT('COPIES')   .OR. CLI$PRESENT('ID') ) THEN
     		HARDCOPY = .TRUE.
     		IDTERM   = 1
     		IF( NFUNC.EQ.0 ) NFUNC = 1
     	    ENDIF
     	ENDIF
C
C  GET THE MEMORY ALLOCATION PARAMETERS...
C
     	ISL = INDEX( CLINE(1:NCLINE), '/A' )
     	IF( ISL.EQ.0 ) GOTO 222
	IF( CLI$PRESENT('ALLOCATE') ) THEN
     	    IF( CLI$GET_VALUE('ALLOCATE',VALUE,N) ) READ( VALUE(1:N),
     +      1000, ERR=888 ) MSET
     	    IF( CLI$GET_VALUE('ALLOCATE',VALUE,N) ) READ( VALUE(1:N),
     +      1000, ERR=888 ) MPTS
 1000	    FORMAT(I)
     	ENDIF
C
C  GET INPUT FILE(S)...
C
 222	ISL = INDEX( CLINE(1:NCLINE), '/S' )
     	IF( ISL.EQ.0 ) GOTO 333
     	IF( CLI$PRESENT('SETUP')
     +.AND. CLI$GET_VALUE('SETUP',VALUE,N) ) THEN
     	    IF(N.GT.32) CALL IF_DCL_N( N, VALUE, IMAGE )
     	    INQUIRE( FILE=VALUE, EXIST=YES )
     	    IF(.NOT.YES) CALL IF_DCL_F( N, VALUE, IMAGE )
     	    DAT_FILE(3) = VALUE(1:32)
     	ENDIF
 333	ISL = INDEX( CLINE(1:NCLINE), '/L' )
     	IF( ISL.EQ.0 ) GOTO 444
     	IF( CLI$PRESENT('LAYOUT')
     +.AND. CLI$GET_VALUE('LAYOUT',VALUE,N) ) THEN
     	    IF(N.GT.32) CALL IF_DCL_N( N, VALUE, IMAGE )
     	    INQUIRE( FILE=VALUE, EXIST=YES )
     	    IF(.NOT.YES) CALL IF_DCL_F( N, VALUE, IMAGE )
     	    DAT_FILE(4) = VALUE(1:32)
     	ENDIF
 444	IF( CLI$PRESENT('P1') ) THEN
     	    DO I=1, 2
     	    IF( CLI$GET_VALUE('P1',VALUE,N) ) THEN
     		IF(N.GT.32) CALL IF_DCL_N( N, VALUE, IMAGE )
     		INQUIRE( FILE=VALUE, EXIST=YES )
     		IF(.NOT.YES) CALL IF_DCL_F( N, VALUE, IMAGE )
     		DAT_FILE(4+I) = VALUE(1:32)
     		NFILES = NFILES + 1
     	    ENDIF
     	    ENDDO
     	ENDIF
C
C  IF IN HARDCOPY MODE, PARSE THE PAGE SETUP PARAMETERS...
C
 999	IF( HARDCOPY ) THEN
     	    IF( NFILES.EQ.0 ) THEN
     		N = IFMISC_LENG(IMAGE)
     		WRITE(6,777) IMAGE(1:N)
 777		FORMAT('_%',A,': missing data file for hardcopy')
     		CALL EXIT
     	    ENDIF
     	    CALL IF_DCL_HPAGE( IDPLOT,DEVICE,HPAGE,COPIES, PAGE_FEED,
     +      PEN_SPEED, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(1),
     +      DAT_FILE(2), IMAGE )
     	ELSE IF( IDTERM.EQ.0 ) THEN
C
C  GET ON-LINE TERMINAL TYPE...
C
     	    CALL IF_DCL_CRT( IDTERM )
     	    IF( IDTERM.EQ.0 ) NFUNC = -1	!QUIT
     	ENDIF
C
C  IF THIS IS A TEKTRONIX OR REGIS'S, INITTIALIZE IT...
C
     	IF( IDTERM.GT.1 ) CALL IFINIT( IDTERM )
C
C  PUT DATA INTO SYSTEM PER-PROCESS COMMON BLOCK...
C
     	IF( NFUNC.GE.0 ) THEN
     	    YES = LIB$PUT_COMMON( BUFFER )
     	    IF( .NOT.YES ) CALL LIB$SIGNAL( %VAL(YES) )
     	ENDIF
     	IF_DCL_PUT = NFUNC
     	RETURN
888	CALL IF_DCL_P( N, VALUE, IMAGE )
     	END

     	SUBROUTINE IF_DCL_HPAGE( IDPLOT, DEVICE, HPAGE, COPIES,
     +  PAGE_FEED, PEN_SPEED, XOFFSET, YOFFSET, XSCALE, YSCALE,
     +  PLOTID, OUTPUT, IMAGE )
C
C	THIS ROUTINE PARSES THE DCL LINE DEFINED IN "GRAFIT.CLD"
C	FOR THE HARDCOPY PAGE SETUP PARAMETERS.
C
     	BYTE      IDPLOT, HPAGE, DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	CHARACTER VALUE*64, PLOTID*(*), OUTPUT*(*), IMAGE*(*)
     	INTEGER   CLI$PRESENT,  CLI$GET_VALUE
     	EXTERNAL  CLI$_NEGATED
C
C  PARSE OPTIONAL HARDCOPY DESTINATION (/HARDCOPY[=destination])...
C
     	IF( CLI$GET_VALUE('HARDCOPY',VALUE,N) ) OUTPUT = VALUE
C
C  PARSE PLOT ID...
C
     	IDPLOT = -1
     	IF( CLI$PRESENT('ID') ) THEN
     	    IDPLOT = 1
     	    IF( CLI$GET_VALUE('ID',VALUE,N) ) PLOTID = VALUE
     	ENDIF
     	IF( CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED) ) IDPLOT = 0
C
C  PARSE HARDCOPY DEVICE...
C
     	IF( CLI$PRESENT('DEVICE')
     +.AND. CLI$GET_VALUE('DEVICE',VALUE,N) ) THEN
     	    IF( VALUE(1:4).EQ.'HP75' ) THEN
     		DEVICE = 1
     	    ELSE IF( VALUE(1:4).EQ.'HP72' ) THEN
     		DEVICE = 2
     	    ELSE IF( VALUE(1:1).EQ.'S' ) THEN
     		DEVICE = 3
     	    ELSE
     		DEVICE = 4
     	    ENDIF
     	ENDIF
C
C  PARSE HARDCOPY NUMBER...
C
     	IF( CLI$PRESENT('COPIES')
     +.AND. CLI$GET_VALUE('COPIES',VALUE,N) ) THEN
     	    READ( VALUE(1:N), 111, ERR=888 ) COPIES
C     	    DECODE( N, 111, VALUE, ERR=888 ) COPIES
 111	    FORMAT(I)
     	    IF( COPIES.LT.1 .OR. COPIES.GT.99 ) GOTO 888
     	ENDIF
C
C  PARSE PAGE_FEED FLAG...
C
     	PAGE_FEED = -1
     	IF(CLI$PRESENT('PAGE_FEED')) PAGE_FEED = 1
     	IF(CLI$PRESENT('PAGE_FEED').EQ.%LOC(CLI$_NEGATED)) PAGE_FEED=0
C
C  PARSE PLOT OFFSET...
C
     	IF( CLI$PRESENT('OFFSET') ) THEN
     	    IF( CLI$GET_VALUE('OFFSET',VALUE,N) ) READ( VALUE(1:N),
     +      222, ERR=888 ) XOFFSET
     	    IF( CLI$GET_VALUE('OFFSET',VALUE,N) ) READ( VALUE(1:N),
     +      222, ERR=888 ) YOFFSET
 222	    FORMAT(F10.0)
     	ENDIF
C
C  PARSE PLOT OVERALL SCALE FACTORS...
C
     	IF( CLI$PRESENT('SCALE') ) THEN
     	    IF( CLI$GET_VALUE('SCALE',VALUE,N) ) READ( VALUE(1:N),
     +      222, ERR=888 ) XSCALE
     	    IF( XSCALE.LE.0.0 .OR. XSCALE.GT.3.0 ) GOTO 888
     	    IF( CLI$GET_VALUE('SCALE',VALUE,N) ) READ( VALUE(1:N),
     +      222, ERR=888 ) YSCALE
     	    IF( YSCALE.LE.0.0 .OR. YSCALE.GT.3.0 ) GOTO 888
     	ENDIF
C
C  PARSE PAGE ALIGNMENT FLAG...
C
     	HPAGE = -1
     	IF( CLI$PRESENT('HPAGE') ) HPAGE = 0
     	IF( CLI$PRESENT('VPAGE') ) HPAGE = 1
C
C  PARSE PEN_SPEED...
C
     	IF( CLI$PRESENT('PEN_SPEED')
     +.AND. CLI$GET_VALUE('PEN_SPEED',VALUE,N) ) THEN
     	    READ( VALUE(1:N), 111, ERR=888 ) PEN_SPEED
C     	    DECODE( N, 111, VALUE, ERR=888 ) PEN_SPEED
     	    IF( PEN_SPEED.LT.1 .OR. PEN_SPEED.GT.9 ) GOTO 888
     	ENDIF
     	RETURN
888	CALL IF_DCL_P( N, VALUE, IMAGE )
     	END

     	SUBROUTINE IF_DCL_N( N, VALUE, IMAGE )
     	CHARACTER VALUE*(*), IMAGE*(*)
     	M = IFMISC_LENG(IMAGE)
     	WRITE(6,1) IMAGE(1:M), VALUE(1:32)
  1	FORMAT('_%',A,': filename ',A,' longer than 32 chars.')
     	CALL EXIT
     	END

     	SUBROUTINE IF_DCL_P( N, VALUE, IMAGE )
     	CHARACTER VALUE*(*), IMAGE*(*)
     	M = IFMISC_LENG(IMAGE)
     	WRITE(6,1) IMAGE(1:M), VALUE(1:N)
  1	FORMAT('_%',A,': invalid parameter ',A)
     	CALL EXIT
     	END

     	SUBROUTINE IF_DCL_F( N, VALUE, IMAGE )
     	CHARACTER VALUE*(*), IMAGE*(*)
     	M = IFMISC_LENG(IMAGE)
     	WRITE(6,1) IMAGE(1:M), VALUE(1:N)
  1	FORMAT('_%',A,': can not find file ',A)
     	CALL EXIT
     	END

     	SUBROUTINE IF_DCL_CRT( IT )
C
C	THIS ROUTINE SOLICITS THE TYPE OF ON-LINE TERMINAL.
C
  1	CALL IFANSI_CLEAR(0)
     	CALL IFANSI_VIDEO(80)
     	CALL IFANSI_VIDEO(90)
     	CALL IFANSI_TEXT('  Types of Graphics Terminals Supported',
     +  41, 8, 19 )
     	CALL IFANSI_VIDEO(30)
     	CALL IFANSI_TEXT('   Please press a desired type number',
     +  41, 15, 19 )
     	CALL IFANSI_VIDEO(47)
     	CALL IFANSI_TEXT('1> ANSI_protocol text terminal',30,10,22)
     	CALL IFANSI_TEXT('2> Tektronix_4100 Graphics Terminal',35,11,22)
     	CALL IFANSI_TEXT('3> ReGIS Graphics Terminal', 26, 12, 22 )
     	CALL IFANSI_TEXT('?> Help           0> Exit', 25, 14, 22 )
  2	CALL IFANSI_CURSOR(14,40)
     	CALL IFQIOW_KEY( KEY )
     	IF( KEY.EQ.26.OR.KEY.EQ.32.OR.KEY.EQ.48.OR.KEY.EQ.69 ) GOTO 999
     	IF( KEY.EQ.63 .OR. KEY.EQ.-81 ) THEN
     	    KEY = IFMISC_HLP( 'TERMINAL', '$ HELP', 22, 0 )
     	    IF( KEY.EQ.0 ) GOTO 1
     	    GOTO 2
     	ENDIF
     	IF( KEY.EQ.65 ) KEY = 49
     	IF( KEY.EQ.84 ) KEY = 50
     	IF( KEY.EQ.82 ) KEY = 51
     	IF( KEY.LT.49 .OR. KEY.GT.51 ) GOTO 2
     	IT = KEY-48
999	RETURN
     	END

     	SUBROUTINE IF_DCL_GET
C
C	GETS PARAMETERS BACK FROM PER-PROCESS COMMON BLOCK.
C
     	LOGICAL   YES
     	CHARACTER BUFFER*252, FILE(6)*32, DAT_FILE*32
     	BYTE      ARRA(10)
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	EQUIVALENCE( BUFFER( 1:), ARRA )
     	EQUIVALENCE( BUFFER(11:), ICRT )
     	EQUIVALENCE( BUFFER(21:), NSET )
     	EQUIVALENCE( BUFFER(25:), NPTS )
     	EQUIVALENCE( BUFFER(31:), XOFF )
     	EQUIVALENCE( BUFFER(35:), YOFF )
     	EQUIVALENCE( BUFFER(39:), XSCL )
     	EQUIVALENCE( BUFFER(43:), YSCL )
     	EQUIVALENCE( BUFFER(61:), FILE )

     	YES = LIB$GET_COMMON( BUFFER )
     	IF( .NOT.YES ) CALL LIB$SIGNAL( %VAL(YES) )
     	NFUNC    = ARRA(1)
     	HARDCOPY = ARRA(2)
     	SKIPDI   = ARRA(3)
     	NFILES   = ARRA(4)
     	IDPLOT   = ARRA(5)
     	HPAGE    = ARRA(6)
     	DEVICE   = ARRA(7)
     	PAGE_FEED= ARRA(8)
     	PEN_SPEED= ARRA(9)
     	COPIES   = ARRA(10)
     	IDTERM   = ICRT
     	CALL IFINIT_ITM( IDTERM )
     	MSET     = NSET
     	MPTS     = NPTS
     	XOFFSET  = XOFF
     	YOFFSET  = YOFF
     	XSCALE   = XSCL
     	YSCALE   = YSCL
     	DO I =1, 6
     	   DAT_FILE(I) = FILE(I)
     	ENDDO
     	RETURN
     	END

     	LOGICAL FUNCTION IF_DCL_HARDCOPY()
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	IF_DCL_HARDCOPY = HARDCOPY
     	RETURN
     	END

     	LOGICAL FUNCTION IF_DCL_SKIPDI()
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	IF_DCL_SKIPDI = SKIPDI
     	RETURN
     	END

     	SUBROUTINE IF_DCL_NFILE( NF )
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	NF = NFILES
     	RETURN
     	END

     	SUBROUTINE IF_DCL_FILE( IT, FNAME )
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	CHARACTER FNAME*(*)
     	IF( IT.GT.0 .AND. IT.LT.3 ) FNAME = DAT_FILE(IT+4)
     	RETURN
     	END

     	SUBROUTINE IF_DCL_SETUP( FNAME )
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	CHARACTER FNAME*(*)
     	FNAME = DAT_FILE(3)
     	RETURN
     	END

     	SUBROUTINE IF_DCL_LAYOUT( FNAME )
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	CHARACTER FNAME*(*)
     	FNAME = DAT_FILE(4)
     	RETURN
     	END

     	SUBROUTINE IF_DCL_VM( MS, MP )
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	MS = MSET
     	MP = MPTS
     	RETURN
     	END

     	SUBROUTINE IF_DCL_HPAR( SETUP, PID, OUT )
     	CHARACTER DAT_FILE*32
     	BYTE      NFUNC, HARDCOPY, SKIPDI, NFILES, IDPLOT, HPAGE
     	BYTE      DEVICE, COPIES, PAGE_FEED, PEN_SPEED
     	COMMON/IF_DCL/ IDTERM, NFUNC, HARDCOPY, SKIPDI, NFILES,
     +  IDPLOT, HPAGE, DEVICE, PAGE_FEED, PEN_SPEED, COPIES,
     +  MSET, MPTS, XOFFSET, YOFFSET, XSCALE, YSCALE, DAT_FILE(6)
     	CHARACTER PID*(*), OUT*(*)
     	DIMENSION SETUP(1)

     	IF( DEVICE.GT.0 ) SETUP(1) = DEVICE
     	IF( COPIES.GT.0 ) SETUP(2) = COPIES
     	IF( IDPLOT.GE.0 ) SETUP(3) = IDPLOT
     	IF( PAGE_FEED.GE.0 ) SETUP(4) = PAGE_FEED
     	IF( XOFFSET.NE.0.0 ) SETUP(5) = XOFFSET
     	IF( YOFFSET.NE.0.0 ) SETUP(6) = YOFFSET
     	IF( XSCALE.GT.0.0  ) SETUP(7) = XSCALE
     	IF( YSCALE.GT.0.0  ) SETUP(8) = YSCALE
     	IF( HPAGE.GE.0     ) SETUP(10)= HPAGE
     	IF( PEN_SPEED.GT.0 ) SETUP(11)= PEN-SPEED
     	IF( IDPLOT.EQ.1    ) PID      = DAT_FILE(1)
     	IF( DAT_FILE(2).NE.' ' )  OUT = DAT_FILE(2)
     	RETURN
     	END

