    	SUBROUTINE IFARCS( IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE DRAWS AN ARC/CIRCLE/ELLIPSE/PIE/DONUN.
C
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- RADIUS IN X-DIMENSION IN INCHES.
C	ARRAY(2) --- RADIUS IN Y-DIMENSION IN INCHES.
C	ARRAY(3) --- BORDER WIDTH (INWARD) IN INCHES.
C		     IF BORDER=RADIUS, A PIE IS DRAWN.
C	ARRAY(4) --- X-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(5) --- Y-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(6) --- ROTATION ANGLE OF OBJECT IN DEGREES FROM X-AXIS.
C	ARRAY(7) --- STARTING ANGLE IN DEGREES TO DRAW THE ARC.
C	ARRAY(8) --- ADDITIVE ANGLE IN DEGREES TO ARRAY(7).
C	ARRAY(9) --- CHORD ANGLE IN DEGREES [10.0].
C
     	LOGICAL PIE
     	REAL*4  ARRAY(1)
C
C  INITIALIZE...
C
     	IRR = IR
     	RD1 = 0.5
     	RD2 = 0.5
     	RD3 = 0.0
     	XPS = 0.0
     	YPS = 0.0
     	ANG0 = 0.0
     	ANG1 = 0.0
     	ANG2 = 360.
     	CHORD = 10.0
     	IF( IRR.GT.0 .AND. ARRAY(1).NE.0.0 ) RD1 = ABS(ARRAY(1))
     	IF( IRR.GT.1 .AND. ARRAY(2).NE.0.0 ) RD2 = ABS(ARRAY(2))
     	IF( IRR.GT.4 ) THEN
     	    XPS = ARRAY(4)
     	    YPS = ARRAY(5)
     	ENDIF
     	IF( IRR.GT.5 ) ANG0 = AMOD( ARRAY(6), 360.0 )
     	IF( IRR.GT.6 ) ANG1 = AMOD( ARRAY(7), 360.0 )
     	IF( IRR.GT.7 ) ANG2 = AMOD( ARRAY(8), 360.0 ) + ANG1
     	IF( ANG1.EQ.ANG2 ) THEN
     	    ANG1 = 0.0
     	    ANG2 = 360.
     	ENDIF
     	IF( ANG1.GT.ANG2 ) THEN
     	    ANGLE = ANG1
     	    ANG1  = ANG2
     	    ANG2  = ANGLE
     	ENDIF
     	IF( IRR.GT.8 .AND. ARRAY(9).GT.0.0 ) THEN
     	    CHORD = ARRAY(9)
     	    IF( CHORD.GT.(ANG2-ANG1) ) CHORD = 0.5*(ANG2-ANG1)
     	ENDIF
     	PIE = .FALSE.
     	IF( IRR.GT.2 .AND. ARRAY(3).NE.0.0 ) THEN
     	    RD3 = ABS(ARRAY(3))
     	    IF( RD3.GE.RD1 .OR. RD3.GE.RD2 ) THEN
     		RD3 = 0.0
     		IF( (ANG2-ANG1).LT.360.0 ) PIE = .TRUE.
     	    ENDIF
     	ENDIF
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	IF( IRR.GT.4 ) CALL IFDRAW( XPS, YPS, -9 )
     	CALL IFDRAW( 0.0, 0.0, 3 )
C
C  SET ROTATION IT AT ALL...
C
    	IF( IRR.GT.5 .AND. ANG0.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, 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 ) THEN
     	    CALL IFPLOT( 0.0, 0.0, 2 )
     	ELSE
     	    CALL IFDRAW( 0.0, 0.0, 3 )
     	ENDIF
     	IF( IRR.GT.5 .AND. ANG0.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFDRAW( -ARRAY(4), -ARRAY(5), -9 )

999	RETURN
    	END

    	SUBROUTINE IFARRH( IT, IR, ARRAY )
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	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- LENGTH OF ARROWHEAD.
C	ARRAY(2) --- HEIGHT OF ARROWHEAD.
C	ARRAY(3) --- HEAD-SECTION LENGTH OF ARROWHEAD.
C	ARRAY(4) --- X-COORDINATE OF HEAD-TIP IN INCHES.
C	ARRAY(5) --- Y-COORDINATE OF HEAD-TIP IN INCHES.
C		     FOR A DOUBLE-ARROW, IT'S THE RIGHT TIP.
C	ARRAY(6) --- 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
     	DIMENSION	ARRAY(1)
     	LOGICAL		TWO
C
C  INITIALIZE...
C
     	ITY = IABS(IT)
     	TWO = .FALSE.
     	IF( ITY.GT.10 ) THEN
     	    ITY = MOD( ITY, 10 )
     	    TWO = .TRUE.
     	ENDIF
    	WID = 0.25
     	WDD = 0.15
    	IF( ITY.EQ.1 ) HGT = 0.03
     	IF( ITY.GT.1 ) HGT = 0.15
     	XPS = 0.0
     	YPS = 0.0
     	ANG = 0.0
     	IRR = IR
     	IF( IRR.GT.0 .AND. ARRAY(1).GT.0.05 ) WID = ARRAY(1)
     	IF( IRR.GT.1 .AND. ARRAY(2).GT.0.01 ) HGT = ARRAY(2)
     	IF( IRR.GT.2 .AND. ARRAY(3).GT.0.02 ) WDD = ARRAY(3)
     	IF( IRR.GT.4 ) THEN
     	    XPS = ARRAY(4)
     	    YPS = ARRAY(5)
     	ENDIF
     	IF( IRR.GT.5 ) ANG = AMOD( ARRAY(6), 360.0 )
     	IF( .NOT.TWO .AND. WDD.GT.WID ) WDD = WID
     	IF( TWO .AND. WDD.GT.0.5*WID ) WDD = 0.5*WID
     	HGT = 0.5*HGT
C
C  MOVE ORIGIN TO (XPS,YPS)...
C
     	IF( ITY.EQ.4 ) CALL IFFILL(1)	!SOLID ARROWHEAD
     	IF( IRR.GT.4 ) CALL IFDRAW( XPS, YPS, -9 )
     	CALL IFDRAW( 0.0, 0.0, 3 )
C
C  SET THE ROTATION IF AT ALL...
C
    	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, YANG )
     	    CALL IFROTA( ANG+XANG, ANG+YANG )
     	ENDIF
C
C  START THE DRAWING...
C
     	IF( ITY.EQ.1 ) THEN	!SINGLE-LINE ARROW
     	    CALL IFDRAW( -WID, 0.0, 2 )
     	    CALL IFDRAW( -WDD, HGT, 3 )
     	    CALL IFDRAW(  0.0, 0.0, 2 )
     	    CALL IFDRAW( -WDD,-HGT, 2 )
     	    IF( TWO ) THEN
     	    	CALL IFDRAW( -WID+WDD, HGT, 3 )
     	    	CALL IFDRAW(     -WID, 0.0, 2 )
     	    	CALL IFDRAW( -WID+WDD,-HGT, 2 )
     	    ENDIF
     	ELSE IF( ITY.EQ.2 ) THEN	!DOUBLE-LINE ARROW
     	    HHH = 0.34*HGT
     	    WTN = HHH*WDD/HGT
     	    CALL IFDRAW( -WDD, HGT, 2 )
     	    CALL IFDRAW(  0.0, 0.0, 3 )
     	    CALL IFDRAW( -WDD,-HGT, 2 )
     	    IF( .NOT.TWO ) THEN
     	    	CALL IFDRAW( -WID, HHH, 3 )
     	    	CALL IFDRAW( -WTN, HHH, 2 )
     	    	CALL IFDRAW( -WTN,-HHH, 3 )
     	    	CALL IFDRAW( -WID,-HHH, 2 )
     	    ELSE
     	    	CALL IFDRAW( -WID+WDD, HGT, 3 )
     	    	CALL IFDRAW(     -WID, 0.0, 2 )
     	    	CALL IFDRAW( -WID+WDD,-HGT, 2 )
     	    	CALL IFDRAW( -WID+WTN, HHH, 3 )
     	    	CALL IFDRAW(     -WTN, HHH, 2 )
     	    	CALL IFDRAW(     -WTN,-HHH, 3 )
     	    	CALL IFDRAW( -WID+WTN,-HHH, 2 )
     	    ENDIF
     	ELSE IF( ITY.GT.2 ) THEN	!CONTOUR 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 )
     	ENDIF
C
C  RESTORE...
C
888	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFDRAW( -ARRAY(4), -ARRAY(5), -9 )
     	IF( ITY.EQ.4 ) CALL IFFILL(0)	!SOLID ARROWHEAD

999	RETURN
    	END

    	SUBROUTINE IFBARS( IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE DRAWS A BAR/BOX.
C
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- BAR LENGTH IN INCHES IN X-AXIS.
C	ARRAY(2) --- BAR HEIGHT IN INCHES IN Y-AXIS.
C	ARRAY(3) --- BAR BORDER WIDTH IN INCHES.
C	ARRAY(4) --- CENTER OF BAR IN INCHES (X).
C	ARRAY(5) --- CENTER OF BAR IN INCHES (Y).
C	ARRAY(6) --- ROTATION ANGLE OF BAR IN DEGREES.
C
     	DIMENSION ARRAY(1)
C
C  INITIALIZE...
C
     	IRR = IR
     	RD1 = 0.5
     	RD2 = 0.5
     	WID = 0.0
     	XPS = 0.0
     	YPS = 0.0
     	ANG = 0.0
     	IF( IRR.GT.0 .AND. ARRAY(1).NE.0.0 ) RD1 = 0.5*ABS(ARRAY(1))
     	IF( IRR.GT.1 .AND. ARRAY(2).NE.0.0 ) RD2 = 0.5*ABS(ARRAY(2))
     	IF( IRR.GT.2 .AND. ARRAY(3).NE.0.0 ) THEN
     	    WID = ABS(ARRAY(3))
     	    IF( WID.GE.RD1 .OR. WID.GE.RD2 ) WID = 0.0
     	ENDIF
     	IF( IRR.GT.4 ) THEN
     	    XPS = ARRAY(4)
     	    YPS = ARRAY(5)
     	ENDIF
     	IF( IRR.GT.5 ) ANG = AMOD( ARRAY(6), 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	IF( IRR.GT.4 ) CALL IFDRAW( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, 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( IRR.GT.5 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFDRAW( -ARRAY(4), -ARRAY(5), -9 )

999	RETURN
    	END
    	SUBROUTINE IFBOXS( IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU		FEB-1986
C
C  	THIS ROUTINE DRAWS A BOX WITH ROUND CORNERS.
C
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- BOX LENGTH IN INCHES IN X-AXIS.
C	ARRAY(2) --- BOX HEIGHT IN INCHES IN Y-AXIS.
C	ARRAY(3) --- BOX BORDER WIDTH IN INCHES.
C	ARRAY(4) --- CENTER OF BOX IN INCHES (X).
C	ARRAY(5) --- CENTER OF BOX IN INCHES (Y).
C	ARRAY(6) --- ROTATION ANGLE OF BOX IN DEGREES.
C
     	DIMENSION ARRAY(1)
C
C  INITIALIZE...
C
     	IRR = IR
     	RD1 = 0.5
     	RD2 = 0.5
     	WID = 0.0
     	XPS = 0.0
     	YPS = 0.0
     	ANG = 0.0
     	IF( IRR.GT.0 .AND. ARRAY(1).NE.0.0 ) RD1 = 0.5*ABS(ARRAY(1))
     	IF( IRR.GT.1 .AND. ARRAY(2).NE.0.0 ) RD2 = 0.5*ABS(ARRAY(2))
     	IF( IRR.GT.2 .AND. ARRAY(3).NE.0.0 ) THEN
     	    WID = ABS(ARRAY(3))
     	    IF( WID.GE.RD1 .OR. WID.GE.RD2 ) WID = 0.0
     	ENDIF
     	IF( IRR.GT.4 ) THEN
     	    XPS = ARRAY(4)
     	    YPS = ARRAY(5)
     	ENDIF
     	IF( IRR.GT.5 ) ANG = AMOD( ARRAY(6), 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	IF( IRR.GT.4 ) CALL IFDRAW( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, 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( IRR.GT.5 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFDRAW( -ARRAY(4), -ARRAY(5), -9 )

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 IFCIRC( IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE DRAWS A SIMPLE CIRCLE.
C
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- RADIUS IN INCHES.
C	ARRAY(2) --- X-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(3) --- Y-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(4) --- CHORD ANGLE IN DEGREES [10.0].
C
     	REAL*4 ARRAY(1)
C
C  INITIALIZE...
C
      	RAD = ABS(ARRAY(1))
     	IF( RAD.LT.0.01 ) RETURN
     	XPS = 0.0
     	YPS = 0.0
      	IF( IR.GT.2 ) THEN
            XPS = ARRAY(2)
            YPS = ARRAY(3)
        ENDIF
     	ANG = 10.0
     	IF( IR.GT.3.AND.ARRAY(4).GT.0 ) ANG=360./INT(360./ARRAY(4))
     	CALL IFDRAW( XPS, YPS, -9 )
        CALL IFDRAW( RAD, 0.0, 3 )
     	DO ANGLE= ANG, 360.0, ANG
     	    XPS = RAD*COSD(ANGLE)
     	    YPS = RAD*SIND(ANGLE)
      	    CALL IFPLOT( XPS, YPS, 2 )
     	ENDDO
     	IF( IR.GT.2 ) CALL IFDRAW( -ARRAY(2), -ARRAY(3), -9 )
      	RETURN
    	END

    	SUBROUTINE IFELLP( IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU	MARCH-1986
C
C	THIS ROUTINE DRAWS A SIMPLE ELLIPSE.
C
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- X-RADIUS IN INCHES.
C	ARRAY(2) --- Y-RADIUS IN INCHES.
C	ARRAY(3) --- X-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(4) --- Y-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(5) --- CHORD ANGLE IN DEGREES [10.0].
C
     	REAL*4 ARRAY(1)
C
C  INITIALIZE...
C
      	XRD = ABS(ARRAY(1))
     	IF( XRD.LT.0.01 ) RETURN
      	YRD = ABS(ARRAY(2))
     	IF( YRD.LT.0.01 ) RETURN
     	XPS = 0.0
     	YPS = 0.0
      	IF( IR.GT.3 ) THEN
            XPS = ARRAY(3)
            YPS = ARRAY(4)
        ENDIF
     	ANG = 10.0
     	IF( IR.GT.4.AND.ARRAY(5).GT.0 ) ANG=360./INT(360./ARRAY(5))
     	CALL IFDRAW( XPS, YPS, -9 )
        CALL IFDRAW( 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
     	IF( IR.GT.3 ) CALL IFDRAW( -ARRAY(3), -ARRAY(4), -9 )
      	RETURN
    	END

     	SUBROUTINE IFFEED( ICODE )
C
C  PROGRAMMER: R.S. ZHOU		SEP-1986
C
C	THIS ROUTINE ENDS THE CURRENT PLOT SESSION...
C
    	INCLUDE 'HP7550.CBS'

     	IF( IPL.GT.NBS-10 ) CALL IFINIT_DUMP
     	IPB(IPL+1) = 'R'		!RESET AXIS ALIGNMENT
    	IPB(IPL+2) = 'O'
    	IPB(IPL+3) = 'S'		!RETURN PEN TO STALL
    	IPB(IPL+4) = 'P'
    	IPL = IPL + 4
    	IF( ICODE.NE.0 ) THEN
    	    IPB(IPL+1) = 'P'
    	    IPB(IPL+2) = 'G'
     	    IPL = IPL + 2
    	ENDIF
    	IPB(IPL+1) = ';'		!TURN OFF THE PLOTTER
     	IPB(IPL+2) = ESC
    	IPB(IPL+3) = '.'
    	IPB(IPL+4) = ')'
    	IPL =  IPL + 4
    	CALL IFINIT_DUMP		!DUMP THE LAST BUFFER
999	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 'HP7550.CBS'
     	PARAMETER (MNP= 1025)		!POLYGON BUFFER
     	BYTE      PEN
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX

     	IF( IPT.EQ.IFP ) GOTO 999

     	IF( IPT.NE.0 ) THEN
     	    IFP = IPT
     	    NPT = 0		!INITIALIZE POLYGON BUFFER POINTER
     	ELSE
     	    IPF = IFP
     	    IFP = 0
     	    JSK = 1
     	    CALL IFFILL_FILL( IPF )
     	    JSK = 0
     	ENDIF

999	RETURN
    	END

     	SUBROUTINE IFFILL_VERTEX( XPS, YPS, IPN )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE STORES POLYGON VERTICES FOR AREA FILL
C	(IT IS CALLED IN SUBROUTINE "IFPLOT").
C
     	INCLUDE		'HP7550.CBS'
     	PARAMETER       (MNP= 1025)		!POLYGON BUFFER
     	BYTE		PEN
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX
     	SAVE		XPSL,YPSL

     	IF( NPT.EQ.MNP-1 ) GOTO 555
C
C  SAVE THE VERTEX...
C
     	IF( NPT.EQ.0 ) THEN
     	    IF( IPN.NE.2 ) GOTO 999	!WAIT FOR THE 1ST PEN DOWN
     	    NPT = 1
     	    IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     		XOP = XPSL*XCTH-YPSL*YSTH
     		YPSL= XPSL*XSTH+YPSL*YCTH
     		XPSL= XOP
     	    ENDIF
     	    XFP(NPT) = XSCL*XPSL + XORS
     	    YFP(NPT) = YSCL*YPSL + YORS
     	    PEN(NPT) = 3
     	ENDIF
     	NPT = NPT + 1
     	PEN(NPT) = IPN
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    XOP = XPS*XCTH-YPS*YSTH
     	    YPS = XPS*XSTH+YPS*YCTH
     	    XPS = XOP
     	ENDIF
     	XFP(NPT) = XSCL*XPS + XORS
     	YFP(NPT) = YSCL*YPS + YORS
     	GOTO 999
C
C  BUFFER OVERFLOW...
C
555	IFP = 0
     	DO I=1, NPT
     	    IPF = PEN(I)
     	    CALL IFPLOT( XFP(I), YFP(I), IPF )
     	ENDDO
     	NPT = 0
     	WRITE(6,1000) MNP-1
1000	FORMAT('__ERROR: POLYGON BUFFER(',I4,' VERTICES) OVERFLOW.',
     1' AREA FILL BYPASSED!')

999	XPSL = XPS
     	YPSL = YPS
     	RETURN
     	END

     	SUBROUTINE IFFILL_FILL( IFP )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE FILLS A POLYGON USING "IFDRAW" COMMANDS.
C
C	IFP --- HATCHING PATTERN NUMBER:
C
C	IFP= 0: NO FILL BUT THE POLYGON IS EDGED/OUTLINED.
C	IFP= 1: SOLID FILL (AUTO-BIDIRECTIONAL. 1-LINEWIDTH SPACING).
C	IFP= 2: HORIZONTAL BIDIRECTIONAL LINES (2-LINEWIDTH SPACING).
C	IFP= 3: HORIZONTAL BIDIRECTIONAL LINES (4-LINEWIDTH SPACING).
C	IFP= 4: HORIZONTAL BIDIRECTIONAL LINES (8-LINEWIDTH SPACING).
C	IFP= 5:   VERTICAL BIDIRECTIONAL LINES (2-LINEWIDTH SPACING).
C	IFP= 6:   VERTICAL BIDIRECTIONAL LINES (4-LINEWIDTH SPACING).
C	IFP= 7:   VERTICAL BIDIRECTIONAL LINES (8-LINEWIDTH SPACING).
C	IFP= 8:  45 DEGREE BIDIRECTIONAL LINES (2-LINEWIDTH SPACING).
C	IFP= 9:  45 DEGREE BIDIRECTIONAL LINES (4-LINEWIDTH SPACING).
C	IFP=10:  45 DEGREE BIDIRECTIONAL LINES (8-LINEWIDTH SPACING).
C	IFP=11: -45 DEGREE BIDIRECTIONAL LINES (2-LINEWIDTH SPACING).
C	IFP=12: -45 DEGREE BIDIRECTIONAL LINES (4-LINEWIDTH SPACING).
C	IFP=13: -45 DEGREE BIDIRECTIONAL LINES (8-LINEWIDTH SPACING).
C	IFP=14:  45 DEGREE BIDIRECTIONAL  DOTS (2-LINEWIDTH SPACING).
C	IFP=15:  45 DEGREE BIDIRECTIONAL  DOTS (4-LINEWIDTH SPACING).
C	IFP=16:  45 DEGREE BIDIRECTIONAL  DOTS (8-LINEWIDTH SPACING).
C
C	IFP>0: FILL AND EDGE THE POLYGON.
C	IFP<0: FILL BUT NOT EDGE THE POLYGON.
C
C	ACTIVE PLOTTING STYLUS DOES NOT AFFECT THE HATCHING PATTERN
C	BUT POLYGON EDGING IS USING THE ACTIVE PLOTTING STYLUS.
C
     	PARAMETER       (MNP= 1025)		!POLYGON BUFFER
     	BYTE		IDI, IPI, PEN
     	LOGICAL		DOT
     	INTEGER*2	EDGE, CEDGE
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX
     	COMMON/IFFILL_EDGE/ NSD,NED,IED,YLINE,EDGE(2,MNP),CEDGE(2,MNP)
C
C  INITIALIZE HATCHING PARAMETERS...
C
     	ANGLE = 0.0
     	IPF = IABS(IFP)
     	IF( NPT.LT.3 .OR. IPF.EQ.0 ) GOTO 888
     	CALL IFSTYL_NOW( LTYP, LWID )
     	YSPAC = 0.012*LWID		!LINEWIDHT IN INCHES
     	IPI = MOD( IPF-2, 3 )
     	IF( IPI.EQ.0 ) YSPAC = 2.0*YSPAC
     	IF( IPI.EQ.1 ) YSPAC = 4.0*YSPAC
     	IF( IPI.EQ.2 ) YSPAC = 8.0*YSPAC
     	IF( IPF.GT.4 ) ANGLE = 90.0
     	IF( IPF.GT.7 ) ANGLE = 45.0
     	IF( IPF.GT.10 .AND. IPF.LT.14 ) ANGLE = -45.0
     	DOT = .FALSE.
     	IF( IPF.GT.13 ) THEN
     	    DOT = .TRUE.
     	    DOTC = 0.012*LWID		!DOT DIAMETER
     	ENDIF
C
C  IF SOLID FILL FOR A SIMPLE POLYGON, GET THE OPTIMUM DRAW DIRECTION...
C
     	IF( IPF.EQ.1 .AND. NPT.LT.6 ) CALL IFFILL_ANGLE( ANGLE )
C
C  TRANSFORM VERTEX COORDINATES IF ANGLE.NE.0.0 ...
C
     	IF( ANGLE.NE.0.0 ) CALL IFFILL_ROTA( -ANGLE )
C
C  SORT POLYGON VERTICES ON ASCENDING Y COORDINATES
C  (EDGE ARRAY STORES THE POINTERS TO VERTICES) ...
C
     	CALL IFFILL_SORT
C
C  SET PLOT ROTATION IF ANGLE.NE.0.0 ...
C
     	IF( ANGLE.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, YANG )
     	    CALL IFROTA( XANG+ANGLE, YANG+ANGLE )
     	ENDIF
C
C  START HATCHING FROM BOTTOM UP...
C
     	YTOP  = YMAX - YSPAC			!TOP Y COORDINATE - YSPAC
     	YLINE = YFP( EDGE(1,  1) )		!GET THE SMALLEST Y-COORDINATE
     	IED = 0					!NUMBER OF FILLED EDGES
     	IDI = 1					!HATCHING DIRECTIONAL FLAG

111	IF( YLINE.GE.YTOP ) GOTO 777		!END OF FILLING!
     	YLINE = YLINE + YSPAC			!GET THE NEXT HATCHING LINE
C
C  GET THE ACTIVE LIST OF EDGES INTERSECTING THE "YLINE"...
C
     	CALL IFFILL_EDGE
C
C  LOOP THROUGH THE EDGES FOR INTERSECTING X-COORDINATES...
C
     	IPI = 1					!JUMP FLAG
     	IF( IDI.GT.0 ) THEN
     	    II1 = 1
     	    II2 = NED
     	    II3 = 1
     	ELSE
     	    II1 = NED
     	    II2 = 1
     	    II3 = -1
     	ENDIF
     	DO I= II1, II2, II3	!BIDIRECTIONAL HATCHING LOOP
     	   J = CEDGE(1,I)
     	   K = CEDGE(2,I)
     	   XING = XFP(K)+(YLINE-YFP(K))*(XFP(J)-XFP(K))/(YFP(J)-YFP(K))
     	   IF( IPI.GT.0 ) THEN
     	       CALL IFDRAW( XING, YLINE, 3 )	!DUMP
     	       XLAST = XING
     	   ELSE IF( .NOT. DOT ) THEN
     	       CALL IFDRAW( XING, YLINE, 2 )	!DRAW
     	   ELSE
222	       XLAST = XLAST + IDI*YSPAC	!DOT
     	       IF( IDI.GT.0 .AND. XLAST.GE.XING ) GOTO 333
     	       IF( IDI.LT.0 .AND. XLAST.LE.XING ) GOTO 333
     	       CALL IFDRAW( XLAST, YLINE, 3 )
     	       CALL IFDRAW( XLAST+DOTC, YLINE, 2 )
     	       GOTO 222
     	   ENDIF
333	   IPI = -IPI
     	ENDDO
     	IDI = -IDI
     	GOTO 111
C
C  IF "IFP" IS NEGATIVE, SKIP EDGING THE POLYGON...
C
777	IF( IFP.LT.0 ) GOTO 999
C
C  EDGE THE POLYGON USING ACTIVE PLOTTING STYLUS...
C
888	DO I=1, NPT
     	   IPF = PEN(I)
     	   CALL IFPLOT( XFP(I), YFP(I), IPF )
     	ENDDO
C
C  SET PLOT ROTATION BACK IF ANGLE.NE.0.0 ...
C
999	IF( ANGLE.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	NPT = 0

     	RETURN
     	END

     	SUBROUTINE IFFILL_ANGLE( ANGLE )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE FINDS THE LONGER PATH FOR SOLID FILL.
C
     	PARAMETER       (MNP= 1025)		!POLYGON BUFFER
     	BYTE		PEN
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX

     	XMAX = XFP(1)
     	YMAX = YFP(1)
     	XMIN = XFP(1)
     	YMIN = YFP(1)
     	DO I=2, NPT
     	   IF( XFP(I).LT.XMIN ) XMIN = XFP(I)
     	   IF( XFP(I).GT.XMAX ) XMAX = XFP(I)
     	   IF( YFP(I).LT.YMIN ) YMIN = YFP(I)
     	   IF( YFP(I).GT.YMAX ) YMAX = YFP(I)
     	ENDDO
     	IF( (XMAX-XMIN) .LT. 0.9*(YMAX-YMIN) ) ANGLE = 90.0

999	RETURN
     	END

     	SUBROUTINE IFFILL_ROTA( ANGLE )
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE TRANFORMS THE POLYGON VERTICES.
C
     	PARAMETER       (MNP= 1025)		!POLYGON BUFFER
     	BYTE		PEN
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX

     	ANG = ANGLE
     	CTH = COSD(ANG)
     	STH = SIND(ANG)
     	DO I=1, NPT
     	   XPS    = XFP(I)*CTH - YFP(I)*STH
     	   YFP(I) = XFP(I)*STH + YFP(I)*CTH
     	   XFP(I) = XPS
     	ENDDO

     	RETURN
     	END

     	SUBROUTINE IFFILL_SORT
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE SORTS THE POLYGON VERTICES ON ASCENDING
C	Y-COORDINATES AND STORES SEQUENCE IN POINTER ARRAY "EDGE".
C
     	PARAMETER       (MNP= 1025, ERR= 0.001)
     	BYTE		PEN
     	LOGICAL		DONE
     	INTEGER*2	EDGE, CEDGE
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX
     	COMMON/IFFILL_EDGE/ NSD,NED,IED,YLINE,EDGE(2,MNP),CEDGE(2,MNP)
C
C  IF THE POLYGON IS NOT CLOSE, FORCE IT...
C
     	IF(  ABS(XFP(1)-XFP(NPT)) .GT. ERR
     1  .OR. ABS(YFP(1)-YFP(NPT)) .GT. ERR ) THEN
     	     NPT = NPT + 1
     	     XFP(NPT) = XFP(1)
     	     YFP(NPT) = YFP(1)
     	     PEN(NPT) = 3
     	ENDIF
C
C  PAIR VERTICES TO FORM EDGES (AN EDGE IMMEDIATELY FOLLOWING
C  A LOOP IS ALSO IGNORED FOR MULTI-LOOP POLYGON)...
C
     	NSD = 0
     	XLP = XFP(1)
     	YLP = YFP(1)
     	YMAX= YLP
     	DO 111 I=1, NPT-1
     	    IF( PEN(I+1).EQ.3 ) THEN	!PEN-UP SIGNIFIES A POSSIBLE LOOP
     		IF( ABS(XLP-XFP(I)) .LT. ERR
     1        .AND. ABS(YLP-YFP(I)) .LT. ERR ) THEN
     		    XLP = XFP(I+1)	!SAVE THE TERMINAL OF LOOP
     		    YLP = YFP(I+1)	!SAVE THE TERMINAL OF LOOP
     		    GOTO 111		!SKIP THIS EDGE
     		ENDIF
     	    ENDIF
     	    NSD = NSD + 1
     	    IF( YFP(I).LT.YFP(I+1) ) THEN
     		EDGE(1,NSD) = I
     		EDGE(2,NSD) = I+1
     	        IF( YFP(I+1).GT.YMAX ) YMAX = YFP(I+1)
     	    ELSE
     		EDGE(1,NSD) = I+1
     		EDGE(2,NSD) = I
     	        IF( YFP(I).GT.YMAX ) YMAX = YFP(I)
     	    ENDIF
111	CONTINUE
C
C  SORT "EDGE" ARRAY ON ASCENDING Y-COORDINATES...
C
222	DONE = .TRUE.
     	DO I=1, NSD-1
     	    IF( YFP(EDGE(1,I)).GT.YFP(EDGE(1,I+1)) ) THEN
     		IED = EDGE(1,I)
     		NED = EDGE(2,I)
     		EDGE(1,I) = EDGE(1,I+1)
      		EDGE(1,I+1) = IED
     		EDGE(2,I) = EDGE(2,I+1)
     		EDGE(2,I+1) = NED
     		DONE = .FALSE.
     	    ENDIF
     	ENDDO
     	IF( .NOT. DONE ) GOTO 222

999	RETURN
     	END

     	SUBROUTINE IFFILL_EDGE
C
C  PROGRAMMER:  RONG-SHENG ZHOU
C		BOSTON COLLEGE, 8/1988
C
C	THIS ROUTINE GETS THE ACTIVE LIST OF EDGES INTERSECTING
C	THE CURRENT HATCHING LINE "YLINE".
C
     	PARAMETER       (MNP= 1025)		!POLYGON BUFFER
     	BYTE		PEN
     	LOGICAL		DONE
     	INTEGER*2	EDGE, CEDGE
     	COMMON/IFFILL/	NPT, XFP(MNP), YFP(MNP), PEN(MNP), YMAX
     	COMMON/IFFILL_EDGE/ NSD,NED,IED,YLINE,EDGE(2,MNP),CEDGE(2,MNP)

     	NED = 0
     	IEDGE = IED
     	DONE  = .TRUE.
     	DO 222 I=IED+1, NSD
     	   YSTR = YFP(EDGE(1,I))
     	   YEND = YFP(EDGE(2,I))
     	   IF( ABS(YSTR-YEND).LT.0.001 ) GOTO 111		!HORIZONTAL LINE
     	   IF( YSTR.GE.YLINE .OR. YEND.LT.YLINE ) GOTO 111	!OUT OF REACH
     	   IF( YEND.EQ.YLINE ) THEN
     		IF( I.EQ.1 ) THEN
     		    I1 = EDGE(2,NSD)
     		    I2 = EDGE(2,I+1)
     		ELSE
     		    I1 = EDGE(2,I-1)
     		    IF( I.EQ.NSD ) THEN
     			I2 = EDGE(2,1)
     		    ELSE
     			I2 = EDGE(2,I+1)
     		    ENDIF
     		ENDIF
     		IF(YFP(I1).LT.YEND.AND.YFP(I2).LT.YEND) GOTO 111
     		IF(YFP(I1).GT.YEND.AND.YFP(I2).GT.YEND) GOTO 111
     	   ENDIF
     	   NED = NED + 1
     	   CEDGE(1,NED) = EDGE(1,I)
     	   CEDGE(2,NED) = EDGE(2,I)
     	   DONE = .FALSE.
     	   GOTO 222
 111	   IF( YEND.LT.YLINE ) THEN
     		IF( DONE ) IEDGE = I
     	   ENDIF
222	CONTINUE
     	IED = IEDGE
     	IF( NED.LT.2 ) GOTO 999
C
C  SORT "CEDGE" ARRAY ON ASCENDING X-COORDINATES...
C
333	DONE = .TRUE.
     	DO I=1, NED-1
     	    J = CEDGE(1,I)
     	    K = CEDGE(2,I)
     	    YSTR=XFP(K)+(YLINE-YFP(K))*(XFP(J)-XFP(K))/(YFP(J)-YFP(K))
     	    J = CEDGE(1,I+1)
     	    K = CEDGE(2,I+1)
     	    YEND=XFP(K)+(YLINE-YFP(K))*(XFP(J)-XFP(K))/(YFP(J)-YFP(K))
     	    IF( YSTR.GT.YEND ) THEN
     		IEDGE = CEDGE(1,I)
     		JEDGE = CEDGE(2,I)
     		CEDGE(1,I) = CEDGE(1,I+1)
      		CEDGE(1,I+1) = IEDGE
     		CEDGE(2,I) = CEDGE(2,I+1)
      		CEDGE(2,I+1) = JEDGE
     		DONE = .FALSE.
     	    ENDIF
     	ENDDO
     	IF( .NOT. DONE ) GOTO 333

999	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 'HP7550.CBS'

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

     	IF( IFONT.EQ.2 .OR. IFN.EQ.2 ) THEN
    	    IF( IPL.GT.NBS-10 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = 'S'
    	    IPB(IPL+2) = 'L'
    	    IPL = IPL + 2
    	    IF( IFONT.EQ.2 ) CALL IFDRAW_CDFF( TAND(15.0) )
    	    IF(   IFN.EQ.2 ) CALL IFDRAW_CDFF( 0.0 )
     	ENDIF

     	IFN = IFONT

999	RETURN
	END

     	SUBROUTINE IFINIT( LOUT, IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU
C	       ALFRED UNIVERSITY, SEP-1986
C
C	THIS ROUTINE INITIALIZES A PLOT PAGE FOR HP7550.
C
C		LOUT --- OUTPUT FILE LOGICAL UNIT
C		IR ----- LENGTH OF "ARRAY"
C		ARRAY -- DEVICE INITIALIZATION PARAMETERS
C
    	INCLUDE 'HP7550.CBS'
     	DIMENSION ARRAY(1)
C
C  INITIALIZE COMMON GRAPHIC PARAMETERS...
C
    	IPL = 0
     	DO I=1, NBS+5
     	   IPB(I) = 0
     	ENDDO
     	LUN = LOUT
     	JXO = 0
     	JYO = 0
     	XSCL = 1.0
     	YSCL = 1.0
    	FUNI = 1016.0
     	IRR  = IR
    	IF( IRR.GT.0 ) JXO = ARRAY(1)*FUNI
    	IF( IRR.GT.1 ) JYO = ARRAY(2)*FUNI
     	IF( IRR.GT.2 .AND. ARRAY(3).GT.0.0 ) XSCL= ARRAY(3)
     	IF( IRR.GT.3 .AND. ARRAY(4).GT.0.0 ) YSCL= ARRAY(4)
     	LTY = 1
     	LWD = 1
     	IF( IRR.GT.4 .AND. ARRAY(5).GT.0.0 ) LWD = ARRAY(5)
     	CALL IFSTYL( LTY, LWD )		!SET PLOTTING STYLUS
C
C  INITIALIZE THE PLOTTER...
C
     	IPB(IPL+1) = ESC	!TURN ON PLOTTER IN CASE OF BYPASS MODE
     	IPB(IPL+2) = '.'
     	IPB(IPL+3) = '('
    	IPB(IPL+4) = 'I'
    	IPB(IPL+5) = 'N'
    	IPB(IPL+6) = 'R'
    	IPB(IPL+7) = 'O'
    	IPL = IPL + 7
    	IF( IRR.GT.5 .AND. ARRAY(6).NE.0.0 ) THEN
    	    IPB(IPL+1) = '9'	!AXIS ALIGNMENT
    	    IPB(IPL+2) = '0'
    	    IPL = IPL + 2
    	ENDIF
      	IPB(IPL+1) = 'I'	!DEFAULT P1,P2
    	IPB(IPL+2) = 'P'
     	IPB(IPL+3) = 'P'	!PLOT ABSOLUTE MODE
     	IPB(IPL+4) = 'A'
     	IPB(IPL+5) = 'S'
     	IPB(IPL+6) = 'P'
     	IPB(IPL+7) = '1'	!SELECT PEN #1
     	IPL = IPL + 7
    	IF( IRR.GT.6 .AND. ARRAY(7).GT.0.0 ) THEN
     	    IPB(IPL+1) = 'V'	!PEN SPEED
    	    IPB(IPL+2) = 'S'
      	    IPL = IPL + 2
    	    CALL IFDRAW_CDIF( INT(ARRAY(7)*ARRAY(7)) )
    	ENDIF

999	RETURN
    	END

    	SUBROUTINE IFINIT_DUMP
C
C  PROGRAMMER: R.S. ZHOU,	SEP-1986
C
C	THIS ROUTINE DUMPS THE GRAPHIC BUFFER "IPB".
C
    	INCLUDE 'HP7550.CBS'

     	IF( IPL.EQ.0 ) GOTO 999
C
C  DUMP THE BUFFER...
C
     	WRITE(LUN,1) (IPB(I),I=1,IPL)
1	FORMAT(<IPL>A1$)
C
C  NULL THE BUFFER...
C
    	DO I=1, IPL
    	   IPB(I) = 0
    	ENDDO
     	IPL = 0

999	RETURN
    	END

     	SUBROUTINE IFINIT_PLOT( XORG, YORG )
C
C	THIS ROUTINE INITIALIZES A PLOT SESSION.
C
     	INCLUDE 'HP7550.CBS'

     	IXO = JXO + INT(XORG*FUNI)
     	IYO = JYO + INT(YORG*FUNI)
     	IXL = IXO
     	IYL = IYO
     	ILP = 0
     	IFN = 1
     	IFP = 0
     	JSK = 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
     	CALL IFDRAW(0.0,0.0,3)	!MOVE TO THE ORIGIN
     	RETURN
     	END

     	SUBROUTINE IFMARK( ICODE, IR, ARRAY )
C
C   PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS THE MARKER SYMBOLS USING "IFDRAW" SUBROUTINE.
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	IR --------- NUMBER OF ELEMENTS IN "ARRAY".
C	ARRAY(1) --- DIAMETER OF SYMBOL IN INCHES.
C	ARRAY(2) --- X-COORDINATE OF SYMBOL CENTER.
C	ARRAY(3) --- X-COORDINATE OF SYMBOL CENTER.
C	ARRAY(4) --- ROTATION ANGLE IN DEGREES.
C
     	INCLUDE 'HP7550.CBS'
     	DIMENSION	ARRAY(1)

     	IRR = IABS(IR)
     	RAD = 0.5*ARRAY(1)
    	IF( RAD.LT.0.005 ) RAD = 0.005
C
C  REORIGIN TO (ARRAY(2),ARRAY(3))...
C
     	CALL IFDRAW( ARRAY(2), ARRAY(3), -3 )
C
C  SET THE SYMBOL ROTATION IF AT ALL...
C
    	IF( IRR.GT.3 .AND. ARRAY(4).NE.0.0 ) THEN
     	    ANGX = XANG
     	    ANGY = YANG
     	    CALL IFROTA( ARRAY(4)+XANG, ARRAY(4)+YANG )
     	ENDIF
C
C  RESET THE SCALE FACTORS...
C
     	IF( XSCL.NE.YSCL ) THEN
     	    XSCF = XSCL
     	    YSCF = YSCL
     	    CALL IFSCAL( XSCF, XSCF )
     	ENDIF
     	LTYOLD = LTY
     	IF( LTY.GT.1 ) CALL IFSTYL(LTY,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_PLUS( RAD )		!PLUS SIGN
     	    CALL IFMARK_CROSS( 0.85*RAD )	!CROSS
     	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 IFDRAW( -ARRAY(2), -ARRAY(3), -3 )
     	IF( XSCF.NE.YSCF ) CALL IFSCAL( XSCF, YSCF )
    	IF( IRR.GT.3.AND.ARRAY(4).NE.0.0 ) CALL IFROTA( ANGX,ANGY )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SQUARE( SIZE )
     	RAD = SIZE
     	CALL IFDRAW(  0.0,  RAD, 2 )
    	CALL IFDRAW( -RAD,  RAD, 2 )
    	CALL IFDRAW( -RAD, -RAD, 2 )
    	CALL IFDRAW(  RAD, -RAD, 2 )
    	CALL IFDRAW(  RAD,  RAD, 2 )
     	CALL IFDRAW(  0.0,  RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SSQUARE( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
    	CALL IFDRAW( -RAD,  RAD, 3 )
    	CALL IFDRAW( -RAD, -RAD, 2 )
    	CALL IFDRAW(  RAD, -RAD, 2 )
    	CALL IFDRAW(  RAD,  RAD, 2 )
     	CALL IFDRAW( -RAD,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_HEXAGON( SIZE )
     	RAD = SIZE
     	ADD = 0.866*RAD
     	DDA = 0.500*RAD
    	CALL IFDRAW(  0.0,  RAD, 2 )
    	CALL IFDRAW( -ADD,  DDA, 2 )
    	CALL IFDRAW( -ADD, -DDA, 2 )
    	CALL IFDRAW(  0.0, -RAD, 2 )
    	CALL IFDRAW(  ADD, -DDA, 2 )
    	CALL IFDRAW(  ADD,  DDA, 2 )
     	CALL IFDRAW(  0.0,  RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SHEXAGON( SIZE )
     	RAD = SIZE
     	ADD = 0.866*RAD
     	DDA = 0.500*RAD
     	CALL IFFILL(1)
    	CALL IFDRAW(  0.0,  RAD, 3 )
    	CALL IFDRAW( -ADD,  DDA, 2 )
    	CALL IFDRAW( -ADD, -DDA, 2 )
    	CALL IFDRAW(  0.0, -RAD, 2 )
    	CALL IFDRAW(  ADD, -DDA, 2 )
    	CALL IFDRAW(  ADD,  DDA, 2 )
     	CALL IFDRAW(  0.0,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_TRIANGLE( SIZE )
     	RAD = SIZE
     	ADD = 0.500*RAD
     	DDA = 0.866*RAD
     	CALL IFDRAW(  0.0,  RAD, 2 )
    	CALL IFDRAW( -DDA, -ADD, 2 )
    	CALL IFDRAW(  DDA, -ADD, 2 )
    	CALL IFDRAW(  0.0,  RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_STRIANGLE( SIZE )
     	RAD = SIZE
     	ADD = 0.500*RAD
     	DDA = 0.866*RAD
     	CALL IFFILL(1)
     	CALL IFDRAW(  0.0,  RAD, 3 )
    	CALL IFDRAW( -DDA, -ADD, 2 )
    	CALL IFDRAW(  DDA, -ADD, 2 )
    	CALL IFDRAW(  0.0,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_DIAMOND( SIZE )
     	RAD = SIZE
     	CALL IFDRAW(  0.0,  RAD, 2 )
    	CALL IFDRAW( -RAD,  0.0, 2 )
    	CALL IFDRAW(  0.0, -RAD, 2 )
    	CALL IFDRAW(  RAD,  0.0, 2 )
    	CALL IFDRAW( 0.0, RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_SDIAMOND( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFDRAW(  0.0,  RAD, 3 )
    	CALL IFDRAW( -RAD,  0.0, 2 )
    	CALL IFDRAW(  0.0, -RAD, 2 )
    	CALL IFDRAW(  RAD,  0.0, 2 )
    	CALL IFDRAW(  0.0,  RAD, 2 )
     	CALL IFFILL(0)
     	RETURN
     	END

     	SUBROUTINE IFMARK_PLUS( SIZE )
     	RAD = SIZE
     	CALL IFDRAW(  0.0,  RAD, 3 )
    	CALL IFDRAW(  0.0, -RAD, 2 )
    	CALL IFDRAW( -RAD,  0.0, 3 )
    	CALL IFDRAW(  RAD,  0.0, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_CROSS( SIZE )
     	RAD = SIZE
     	CALL IFDRAW( -RAD, -RAD, 3 )
    	CALL IFDRAW(  RAD,  RAD, 2 )
    	CALL IFDRAW( -RAD,  RAD, 3 )
    	CALL IFDRAW(  RAD, -RAD, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_DTRIANGLE( SIZE )
     	RAD = SIZE
     	ADD = 0.25*RAD
    	DDA = -RAD + ADD
    	DDD =  RAD + ADD
    	CALL IFDRAW(  0.0, DDD, 3 )
    	CALL IFDRAW( -RAD, DDA, 2 )
    	CALL IFDRAW(  RAD, DDA, 2 )
    	CALL IFDRAW(  0.0, DDD, 2 )
    	DDA = DDA - ADD - ADD
    	DDD = DDD - ADD - ADD
    	CALL IFDRAW(  0.0, DDA, 3 )
    	CALL IFDRAW( -RAD, DDD, 2 )
    	CALL IFDRAW(  RAD, DDD, 2 )
    	CALL IFDRAW(  0.0, DDA, 2 )
     	RETURN
     	END

     	SUBROUTINE IFMARK_CIRCLE( SIZE )
     	RAD = SIZE
     	CALL IFDRAW( 0.0, -RAD, 3 )
     	DO I=-80,270,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_RMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFDRAW( 0.0, -RAD, 3 )
     	DO I=-80,90,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFDRAW( 0.0, RAD, 3 )
     	DO I=100,270,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_LMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFDRAW( 0.0, RAD, 3 )
     	DO I=100,270,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFDRAW( 0.0, -RAD, 3 )
     	DO I=-80,90,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_TMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFDRAW( RAD, 0.0, 3 )
     	DO I=10,180,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFDRAW( -RAD, 0.0, 3 )
     	DO I=-170,0,10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

     	SUBROUTINE IFMARK_BMOON( SIZE )
     	RAD = SIZE
     	CALL IFFILL(1)
     	CALL IFDRAW( RAD, 0.0, 3 )
     	DO I=-10,-180,-10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFDRAW( -RAD, 0.0, 3 )
     	DO I=170,0,-10
     	   CALL IFDRAW( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	RETURN
     	END

    	SUBROUTINE IFOBLI( IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE DRAWS AN OBLIQUE.
C
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- DIAMETER OF OBLIQUE IN X-AXIS IN INCHES.
C	ARRAY(2) --- DIAMETER OF OBLIQUE IN Y-AXIS IN INCHES.
C	ARRAY(3) --- BORDER WIDTH (INWARD) IN INCHES.
C	ARRAY(4) --- X-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(5) --- Y-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(6) --- ROTATION ANGLE OF OBJECT IN DEGREES FROM X-AXIS.
C
     	DIMENSION	ARRAY(1)
C
C  INITIALIZE...
C
     	IRR = IR
     	RD1 = 1.0
     	RD2 = 0.5
     	WID = 0.0
     	XPS = 0.0
     	YPS = 0.0
     	ANG = 0.0
     	IF( IRR.GT.0 .AND. ARRAY(1).NE.0.0 ) RD1 = 0.5*ABS(ARRAY(1))
     	IF( IRR.GT.1 .AND. ARRAY(2).NE.0.0 ) RD2 = 0.5*ABS(ARRAY(2))
     	IF( IRR.GT.2 .AND. ARRAY(3).NE.0.0 ) THEN
     	    WID = ABS(ARRAY(3))
     	    IF( WID.GE.RD1 .OR. WID.GE.RD2 ) WID = 0.0
     	ENDIF
     	IF( IRR.GT.4 ) THEN
     	    XPS = ARRAY(4)
     	    YPS = ARRAY(5)
     	ENDIF
     	IF( IRR.GT.5 ) ANG = AMOD( ARRAY(6), 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	IF( IRR.GT.4 ) CALL IFDRAW( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, 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	CALL IFDRAW( 0.0, 0.0, 3 )
     	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFDRAW( -ARRAY(4), -ARRAY(5), -9 )

999	RETURN
    	END
     	SUBROUTINE IFPLOT( XOP, YOP, IPF )
C
C   PROGRAMMER: R.S. ZHOU,  8/1988
C
C	THIS ROUTINE GENERATES VECTORS IN ACTIVE LINE TYPE.
C
C    	IPF =  2: DRAW TO (XOP,YOP)
C	IPF =  3: MOVE TO (XOP,YOP)
C	IPF = -3: MOVE TO (XOP,YOP) AND REORIGIN
C	IPF = -9: REORIGIN TO (XOP,YOP) ONLY
C
     	INCLUDE 'HP7550.CBS'

     	XPS = XOP
     	YPS = YOP
     	IF( IFP.NE.0 .AND. IPF.GT.0 ) THEN
     	    CALL IFFILL_VERTEX( XPS, YPS, IPF )
     	ELSE IF( LTY.EQ.1 .OR. IPF.NE.2 ) THEN
     		 CALL IFDRAW( XPS, YPS, IPF )
     	ELSE IF( LTY.EQ.2 ) THEN
     		 CALL IFDRAW_DASH1( XPS, YPS )
     	ELSE IF( LTY.EQ.3 ) THEN
     		 CALL IFDRAW_DASH2( XPS, YPS )
     	ELSE IF( LTY.EQ.4 ) THEN
     		 CALL IFDRAW_DASH3( XPS, YPS )
     	ELSE IF( LTY.EQ.5 ) THEN
     		 CALL IFDRAW_DASH4( XPS, YPS )
     	ELSE IF( LTY.EQ.6 ) THEN
     		 CALL IFDRAW_DASH5( XPS, YPS )
     	ELSE IF( LTY.EQ.7 ) THEN
     		 CALL IFDRAW_DASH6( XPS, YPS )
     	ELSE IF( LTY.EQ.8 ) THEN
     		 CALL IFDRAW_DASH7( XPS, YPS )
     	ENDIF

999	RETURN
     	END

     	SUBROUTINE IFDRAW( 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: MOVE TO (XOP,YOP) AND REORIGIN
C	IPF = -9: REORIGIN TO (XOP,YOP) ONLY
C
    	INCLUDE 'HP7550.CBS'
	SAVE IPP
C
C  CONVERT COORDINATES TO ABSOLUTE PLOTTER UNITS...
C
    	IPN = IABS(IPF)
     	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
     	YPS = YPS*YSCL
     	IF( JSK.EQ.0 ) THEN
     	    XPS = XPS + XORS
     	    YPS = YPS + YORS
     	ENDIF
     	IF( IPN.EQ.9 ) GOTO 888
     	IXL = IXO+INT(FUNI*XPS)
     	IYL = IYO+INT(FUNI*YPS)
     	IF( IXL.LT.0 ) IXL = 0
     	IF( IYL.LT.0 ) IYL = 0
     	IF( IPL.GT.NBS-15 ) CALL IFINIT_DUMP

     	IF( IPN.EQ.IPP .AND. IPN.EQ.2 ) THEN
     	    IPL = IPL + 1
     	    IPB(IPL) = ','
     	ELSE
     	    IPB(IPL+1) = 'P'
     	    IPL = IPL + 2
     	    IF( IPN.EQ.2 ) THEN
     		IPB(IPL) = 'D'
     	    ELSE
     		IPB(IPL) = 'U'
     	    ENDIF
	ENDIF

     	CALL IFDRAW_CDIF( IXL )
     	IPL = IPL + 1
     	IPB(IPL) = ','
     	CALL IFDRAW_CDIF( IYL )
C
C  KEEP TRACK OF WORKING ORIGIN...
C
888	IF( IPF.LT.0 ) THEN
    	    XORS = XPS
     	    YORS = YPS
    	ENDIF
	IPP = IPN

999	RETURN
    	END

    	SUBROUTINE IFDRAW_CDIF( INTVAR )
C
C  PROGRAMMER: R.S. ZHOU
C
C	THIS ROUTINE PACKS AN INTERGER VARIABLE INTO THE GRAPHIC BUFFER.
C
    	INCLUDE 'HP7550.CBS'

    	BYTE TEXT(6)
    	DATA TEXT / 6*0 /

    	IN = INTVAR
    	ENCODE( 6, 1, TEXT ) IN
1	FORMAT(I6)
    	DO I=1, 6
    	   IF( TEXT(I).GT.32 ) THEN
    	       IPL = IPL + 1
    	       IPB(IPL) = TEXT(I)
     	   ENDIF
     	ENDDO	

    	RETURN
    	END

    	SUBROUTINE IFDRAW_CDFF( DECIMAL )
C
C  PROGRAMMER: R.S. ZHOU
C
C	THIS ROUTINE PACKS A DECIMAL VARIABLE INTO THE GRAPHIC BUFFER.
C
    	INCLUDE 'HP7550.CBS'
    	BYTE TEXT(8)
    	DATA TEXT / 8*0 /

    	DEC = DECIMAL
    	ENCODE( 8, 1, TEXT ) DEC
1	FORMAT(F8.3)
    	DO I=1, 8
    	   IF( TEXT(I).GT.42 ) THEN
    	       IPL = IPL + 1
    	       IPB(IPL) = TEXT(I)
     	   ENDIF
     	ENDDO
    	IF( IPB(IPL).NE.'0' ) GOTO 9
    	IPB(IPL) = 0
    	IPL = IPL - 1
    	IF( IPB(IPL).NE.'0' ) GOTO 9
    	IPB(IPL) = 0
    	IPL = IPL - 1
    	IF( IPB(IPL).NE.'0' ) GOTO 9
    	IPB(IPL) = 0
    	IPL = IPL - 1
9	RETURN
    	END

     	SUBROUTINE IFDRAW_LAST( XPS, YPS )
C
C	THIS ROUTINE REPORTS THE LAST PEN LOCATION
C	RELATIVE TO ACTIVE GRAPH ORIGIN IN INCHES.
C
     	INCLUDE 'HP7550.CBS'

     	XPL = FLOAT(IXL-IXO)/FUNI
     	YPL = FLOAT(IYL-IYO)/FUNI
     	IF( JSK.EQ.0 ) THEN
     	    XPL = XPL-XORS
     	    YPL = YPL-YORS
     	ENDIF
     	XPL = XPL/XSCL
     	YPL = YPL/YSCL
     	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 IFDRAW_DASH1( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A DOTTED LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR
    	FC1C = (0.03+0.01*IFWD)*CTH
    	FC1S = (0.03+0.01*IFWD)*STH
     	DOTC = (0.01*IFWD)*CTH
     	DOTS = (0.01*IFWD)*STH

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, 3 )

111	XAD = XAD + DOTC
     	YAD = YAD + DOTS
     	CALL IFDRAW( XAD, YAD,  2 )
222	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, 3 )
     	XAD = XAD + DOTC
     	YAD = YAD + DOTS
     	CALL IFDRAW( XAD, YAD,  2 )
    	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, 3 )
    	DRES = DRES - DIST

999    	RETURN
    	END

     	SUBROUTINE IFDRAW_DASH2( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A DASH-DOT LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )

111	FC1C = (0.05+0.01*IFWD)*CTH
    	FC1S = (0.05+0.01*IFWD)*STH
     	FC2C = (0.03+0.01*IFWD)*CTH
    	FC2S = (0.03+0.01*IFWD)*STH
     	DOTC = (0.01*IFWD)*CTH
     	DOTS = (0.01*IFWD)*STH
    	IF( IFID.EQ.1 ) GOTO 333
    	IF( IFID.EQ.2 ) GOTO 444
222	IFID = 1
    	IFIP = 2
    	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
333	IFID = 2
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
444    	XAD = XAD + DOTC
     	YAD = YAD + DOTS
     	CALL IFDRAW( XAD, YAD,  2 )
    	IFID = 3
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
     	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, IFIP )
    	DRES = DRES - DIST

999    	RETURN
    	END

     	SUBROUTINE IFDRAW_DASH3( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A SHORT DASH LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )

111	FC1C = (0.04+0.01*IFWD)*CTH
    	FC1S = (0.04+0.01*IFWD)*STH
     	FC2C = (0.03+0.01*IFWD)*CTH
    	FC2S = (0.03+0.01*IFWD)*STH
    	IF( IFID.EQ.1 ) GOTO 333
222    	IFID = 1
    	IFIP = 2
    	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
333    	IFID = 2
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD,YAD, IFIP )
    	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, IFIP )
    	DRES = DRES - DIST

999    	RETURN
    	END

     	SUBROUTINE IFDRAW_DASH4( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A MEDIUM DASH LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )

111	FC1C = (0.06+0.01*IFWD)*CTH
    	FC1S = (0.06+0.01*IFWD)*STH
     	FC2C = (0.03+0.01*IFWD)*CTH
     	FC2S = (0.03+0.01*IFWD)*STH
    	IF( IFID.EQ.1 ) GOTO 333
222    	IFID = 1
    	IFIP = 2
    	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
333    	IFID = 2
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD,YAD, IFIP )
    	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, IFIP )
    	DRES = DRES - DIST

999    	RETURN
    	END

     	SUBROUTINE IFDRAW_DASH5( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A THREE-DOT CENTER LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )

111	FC1C = (0.10+0.01*IFWD)*CTH
    	FC1S = (0.10+0.01*IFWD)*STH
     	FC2C = (0.03+0.01*IFWD)*CTH
    	FC2S = (0.03+0.01*IFWD)*STH
     	DOTC = (0.01*IFWD)*CTH
     	DOTS = (0.01*IFWD)*STH
    	IF( IFID.EQ.1 ) GOTO 333
    	IF( IFID.EQ.2 ) GOTO 444
    	IF( IFID.EQ.3 ) GOTO 555
    	IF( IFID.EQ.4 ) GOTO 666
222	IFID = 1
    	IFIP = 2
    	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
333	IFID = 2
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
444    	XAD = XAD + DOTC
     	YAD = YAD + DOTS
     	CALL IFDRAW( XAD, YAD,  2 )
    	IFID = 3
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
555	XAD = XAD + DOTC
     	YAD = YAD + DOTS
     	CALL IFDRAW( XAD, YAD,  2 )
    	IFID = 4
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
666	XAD = XAD + DOTC
     	YAD = YAD + DOTS
     	CALL IFDRAW( XAD, YAD,  2 )
    	IFID = 5
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
     	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, IFIP )
    	DRES = DRES - DIST

999    	RETURN
    	END

     	SUBROUTINE IFDRAW_DASH6( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A LONG-SHORT DASH LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )

111	FC1C = (0.08+0.01*IFWD)*CTH
    	FC1S = (0.08+0.01*IFWD)*STH
    	FC2C = (0.03+0.01*IFWD)*CTH
    	FC2S = (0.03+0.01*IFWD)*STH
    	FC3C = (0.03+0.01*IFWD)*CTH
    	FC3S = (0.03+0.01*IFWD)*STH
    	IF( IFID.EQ.1 ) GOTO 333
    	IF( IFID.EQ.2 ) GOTO 444
    	IF( IFID.EQ.3 ) GOTO 555
222	IFID = 1
    	IFIP = 2
    	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
333	IFID = 2
    	IFIP = 3
    	XAD = XAD + FC3C
    	YAD = YAD + FC3S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
444	IFID = 3
    	IFIP = 2
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
555	IFID = 4
    	IFIP = 3
    	XAD = XAD + FC3C
    	YAD = YAD + FC3S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
    	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, IFIP )
    	DRES = DRES - DIST

999    	RETURN
    	END

     	SUBROUTINE IFDRAW_DASH7( X2, Y2 )
C
C   PROGRAMMER:  R.S. ZHOU,	8/1988
C
C	THIS ROUTINE DRAWS A LOOSE DASH LINE.
C
     	PARAMETER (ERR= 0.005)
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	CALL IFDRAW_LAST( X1, Y1 )	!GET THE LAST POINT.

    	DIST = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
    	IF( DIST.EQ.0.0 ) GOTO 999

     	XAD  = X1
     	YAD  = Y1
    	STH  = (Y2-Y1)/DIST
    	CTH  = (X2-X1)/DIST
     	DERR = DIST + ERR

    	IF( DRES.LT.0.01 ) GOTO 111
C
C  PLOT THE REMAINING SEGMENT FROM THE PREVIOUS DASH...
C
    	XAD = XAD + DRES*CTH
    	YAD = YAD + DRES*STH
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )

111	FC1C = (0.04+0.01*IFWD)*CTH
    	FC1S = (0.04+0.01*IFWD)*STH
     	FC2C = (0.05+0.01*IFWD)*CTH
    	FC2S = (0.05+0.01*IFWD)*STH
    	IF( IFID.EQ.1 ) GOTO 333
222    	IFID = 1
    	IFIP = 2
    	XAD = XAD + FC1C
    	YAD = YAD + FC1S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD, YAD, IFIP )
333    	IFID = 2
    	IFIP = 3
    	XAD = XAD + FC2C
    	YAD = YAD + FC2S
    	DRES = SQRT( (XAD-X1)**2 + (YAD-Y1)**2 )
    	IF( DRES.GT.DERR ) GOTO 888
    	CALL IFDRAW( XAD,YAD, IFIP )
    	GOTO 222
C
C   DRAW TO THE END OF THE LINE...
C
888	CALL IFDRAW( X2, Y2, IFIP )
    	DRES = DRES - DIST

999    	RETURN
    	END

    	SUBROUTINE IFPOLY( NS, IR, ARRAY )
C
C  PROGRAMMER: R.S. ZHOU		MARCH-1986
C
C	THIS ROUTINE DRAWS A POLYGON.
C
C	NS --------- NUMBER OF SIDES/EDGES.
C	IR --------- LENGTH OF "ARRAY".
C	ARRAY(1) --- DIAMETER OF POLYGON IN INCHES.
C	ARRAY(2) --- BORDER WIDTH (INWARD) IN INCHES.
C	ARRAY(3) --- X-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(4) --- Y-COORDINATE OF THE CENTER IN INCHES.
C	ARRAY(5) --- ROTATION ANGLE OF OBJECT IN DEGREES FROM X-AXIS.
C
     	REAL*4 ARRAY(1)
C
C  INITIALIZE...
C
     	NSD = NS
     	IF( NSD.LT.3 ) NSD = 3
     	IRR = IR
     	RAD = 0.5
     	WID = 0.0
     	XPS = 0.0
     	YPS = 0.0
     	ANG = 0.0
     	IF( IRR.GT.0 .AND. ARRAY(1).NE.0.0 ) RAD = 0.5*ABS(ARRAY(1))
     	IF( IRR.GT.1 .AND. ARRAY(2).NE.0.0 ) THEN
     	    WID = ABS(ARRAY(2))
     	    IF( WID.GE.RAD ) WID = 0.0
     	ENDIF
     	IF( IRR.GT.3 ) THEN
     	    XPS = ARRAY(3)
     	    YPS = ARRAY(4)
     	ENDIF
     	IF( IRR.GT.4 ) ANG = AMOD( ARRAY(5), 360.0 )
C
C  MOVE ORIGIN TO (XPS,YPS) ...
C
     	IF( IRR.GT.3 ) CALL IFDRAW( XPS, YPS, -9 )
C
C  SET ROTATION IF AT ALL...
C
     	IF( IRR.GT.4 .AND. ANG.NE.0.0 ) THEN
     	    CALL IFROTA_NOW( XANG, 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	CALL IFDRAW( 0.0, 0.0, 3 )
     	IF( IRR.GT.4 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.3 ) CALL IFDRAW( -ARRAY(3), -ARRAY(4), -9 )

999	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 'HP7550.CBS'

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

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

     	ANGX = XANG
     	ANGY = YANG

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

    	IF( XFAC.GT.0.0 ) XSCL = XFAC
    	IF( YFAC.GT.0.0 ) YSCL = YFAC

999	RETURN
    	END

    	SUBROUTINE IFSCAL_NOW( XFAC, YFAC )
C
C   THIS ROUTINE REPORTS THE CURRENT SCALE FACTORS IN XFAC,YFAC.
C
    	INCLUDE 'HP7550.CBS'

    	XFAC = XSCL
    	YFAC = YSCL

999	RETURN
    	END

     	SUBROUTINE IFSPEN( IPEN )
C
C  PROGRAMMER: R.S. ZHOU	SEP-1986
C
C	THIS ROUTINE SELECTS A NEW PEN OF NUMBER "IPEN".
C
    	INCLUDE 'HP7550.CBS'

     	IPN = IPEN
     	IF( IPN.EQ.ILP ) GOTO 999
     	IF( IPN.LT.1 .OR. IPN.GT.8 ) IPN = 1
     	IF( IPL.GT.NBS-3 ) CALL IFINIT_DUMP
     	IPB(IPL+1) = 'S'
     	IPB(IPL+2) = 'P'
     	IPB(IPL+3) = 48 + IPN
     	IPL = IPL + 3
     	ILP = IPN

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 (SOFEWARE IMPLEMENTATION).
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: LOOSE DASH
C
C	LWID: ACTIVE LINE WIDTH NUMBER (HARDWARE IMPLEMENTATION).
C
	INCLUDE 'HP7550.CBS'
     	COMMON/IFDRAW_DASH/ IFID, IFIP, IFWD, DRES

     	IF( LTYP.EQ.LTY .AND. LWID.EQ.LWD ) 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
C
C  INITIALIZE LINE ATTRIBUTES...
C
     	IFID = 0		!LINE SEGMENT POINTER
     	IFIP = 2		!PEN UP/DOWN INDICATOR
     	IFWD = LWD		!LINE WIDTH FLAG
     	DRES = 0		!RESIDUAL DASH SEGMENT

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

     	LTYP = LTY
     	LWID = LWD

     	RETURN
     	END
    	SUBROUTINE IFTEXT( NCHS, TEXT, IR, ARRAY )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY	JAN-1986
C
C	THIS ROUTINE HANDLES THE GRAPHTEXT PLOTTING.
C
C	NCHS -------- NUMBER OF CHARACTERS IN "TEXT".
C	TEXT -------- TEXTSTRING TO BE PLOTTED IN CHARACTER FORMAT.
C	IR ---------- LENGTH OF THE "ARRAY"
C	ARRAY(1) ---- STARTING POSITION (X) OF "TEXT".
C	ARRAY(2) ---- STARTING POSITION (Y) OF "TEXT"
C	ARRAY(3) ---- WIDTH OF "TEXT" IN INCHES.
C	ARRAY(4) ---- HEIGHT OF "TEXT" IN INCHES.
C	ARRAY(5) ---- ROTATION ANGLE OF "TEXT" IN DEGREES.
C
    	INCLUDE 'HP7550.CBS'
    	CHARACTER	TEXT(1)*1
     	LOGICAL		BOLDFACE
     	PARAMETER	(CIN = 2.54)	!INCH TO CENTIMETER CONVERSION FACTOR
     	DIMENSION	ARRAY(1)

     	IF( NCHS.EQ.0 ) RETURN
     	NCH = IABS(NCHS)
C
C  SET THE CHARACTER SIZE...
C
     	IF( IR.GT.3 ) THEN
     	    IF( IPL.GT.NBS-19 ) CALL IFINIT_DUMP
    	    IPB(IPL+1) = 'S'
    	    IPB(IPL+2) = 'I'
    	    IPL = IPL + 2
    	    CALL IFDRAW_CDFF( 0.7*ARRAY(3)*XSCL*CIN )
    	    IPL = IPL + 1
    	    IPB(IPL) = ','
    	    CALL IFDRAW_CDFF( ARRAY(4)*YSCL*CIN )
     	ENDIF
C
C  SET STRING ROTATION...
C
     	IF( IR.GT.4 ) THEN
    	    ANGLE = AMOD( ARRAY(5)+XANG, 360.0 )
    	    IF( ANGLE.LT.0.0 ) ANGLE = 360.0 + ANGLE
    	    IF( ANGLE.NE.0.0 ) THEN
    	        IF( IPL.GT.NBS-19 ) CALL IFINIT_DUMP
    	    	IPB(IPL+1) = 'D'
    	    	IPB(IPL+2) = 'I'
    	    	IPL = IPL + 2
    	    	CALL IFDRAW_CDFF( COSD(ANGLE) )
    	    	IPL = IPL + 1
    	    	IPB(IPL) = ','
    	    	CALL IFDRAW_CDFF( SIND(ANGLE) )
     	    ENDIF
     	ENDIF
C
C  MOVE TO THE STARTING POSITION...
C
    	IF( IR.GT.1 ) THEN
     	    XPS = ARRAY(1)
     	    YPS = ARRAY(2)
     	ELSE
     	    XPS = 0.0
     	    YPS = 0.0
     	ENDIF
     	BOLDFACE = .FALSE.
111	CALL IFDRAW( XPS, YPS, 3 )
C
C  LOAD THE LABEL...
C
     	IF( IPL.GT.NBS-NCH-3 ) CALL IFINIT_DUMP
     	IPB(IPL+1) = 'L'
     	IPB(IPL+2) = 'B'
    	IPL = IPL + 2
    	DO I=1, NCH
    	    IPL = IPL + 1
    	    IPB(IPL) = ICHAR( TEXT(I) )
    	ENDDO
    	IPL = IPL + 1
    	IPB(IPL) = 3
     	IF( IFN.NE.3 .OR. BOLDFACE ) GOTO 222
     	BOLDFACE = .TRUE.
     	XPS = XPS + 0.015*COSD(ANGLE)
     	YPS = YPS + 0.015*SIND(ANGLE)
     	GOTO 111
C
C  RESET ROTATION TO ZERO...
C
222	IF( IR.GT.4 .AND. ANGLE.NE.0.0 ) THEN
    	    IF( IPL.GT.NBS-2 ) CALL IFINIT_DUMP
     	    IPB(IPL+1) = 'D'
     	    IPB(IPL+2) = 'I'
     	    IPL = IPL + 2
    	ENDIF

999	RETURN
    	END

