    	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 IFPLOT( XPS, YPS, -9 )
     	CALL IFPLOT( 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 IFPLOT( 0.0, 0.0, 3 )
     	ENDIF
     	IF( IRR.GT.5 .AND. ANG0.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFPLOT( -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( IRR.GT.4 ) CALL IFPLOT( XPS, YPS, -9 )
     	CALL IFPLOT( 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 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
888	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFPLOT( -ARRAY(4), -ARRAY(5), -9 )

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 IFPLOT( 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 IFPLOT( -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
     	REAL*4 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 IFPLOT( 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 IFPLOT( -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
     	INCLUDE 'PSFILE.CBS'
     	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
     	CALL IFPLOT( XPS, YPS, 1 )
        WRITE(LUN,1) XPS, YPS, 72.0*RAD
  1     FORMAT('newpath',3F7.1,' 0 360 arc')
      	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
        INCLUDE 'PSFILE.CBS'
     	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
        YSC = YRD/XRD
     	CALL IFPLOT( XPS, YPS, 1 )
        WRITE(LUN,1) YSC, XPS, YPS/YSC, 72.0*XRD, 1.0/YSC
  1     FORMAT('newpath 1',F10.7,' scale',F7.1,F10.4,F7.1,
     +' 0 360 arc 1',F10.7,' scale')
      	RETURN
    	END

     	SUBROUTINE IFFEED( ICODE )
C
C  PROGRAMMER: R.S. ZHOU		SEP-1986
C
C	THIS ROUTINE ENDS THE CURRENT PLOT SESSION...
C
    	INCLUDE 'PSFILE.CBS'
     	IF( NVEC.GT.0 ) CALL IFPLOT_DUMP(0)
     	IF( ICODE.NE.0 ) WRITE(LUN,1000)
1000	FORMAT('stroke showpage')
     	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
C	FOR THE TIME BEING, FILL-PATTERNS ARE IMPLEMENTED
C	AS SHADING OF DIFFERENT GRAY LEVELS.
C
    	INCLUDE 'PSFILE.CBS'

     	IF( IPT.EQ.IFP ) RETURN
     	IF( NVEC.GT.0 ) CALL IFPLOT_DUMP(0)
     	IF( IPT.NE.0 ) THEN
     	    IF( LINE.GT.0 ) WRITE(LUN,4321)
4321	    FORMAT('stroke')
     	    IFP = IPT
     	    JFP = IABS(IFP)
     	    IF( JFP.LT.1 ) JFP = 1
     	    IF( JFP.GT.11) JFP = 11
     	    IF( JFP.GT.1 ) WRITE(LUN,1000) 0.1*(JFP-1)
1000	    FORMAT(F4.2,' setgray')
     	ELSE
     	    IF( IFP.GT.0 ) THEN
     		WRITE(LUN,2000)
2000		FORMAT('gsave eofill grestore')
     		IF( IABS(IFP).GT.1 ) WRITE(LUN,2002)
2002		FORMAT('0.0 setgray')
     		WRITE(LUN,2003)
2003		FORMAT('stroke')
     	    ELSE
     		WRITE(LUN,2001)
2001		FORMAT('eofill')
     		IF( IABS(IFP).GT.1 ) WRITE(LUN,2002)
     	    ENDIF
     	    IFP = 0
     	ENDIF
     	LINE = 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 'PSFILE.CBS'

     	IF( IFONT.GT.0 .AND. IFONT.LT.4 ) 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 A POSTSCRIPT PRINTER.
C
C		LOUT --- OUTPUT FILE LOGICAL UNIT
C		IR ----- LENGTH OF "ARRAY"
C		ARRAY -- DEVICE INITIALIZATION PARAMETERS
C
     	INCLUDE 'PSFILE.CBS'
     	DIMENSION ARRAY(1)
C
C  INITIALIZE COMMON GRAPHIC PARAMETERS...
C
     	LUN = LOUT
     	JXO = 0
     	JYO = 0
     	XSCL = 1.0
     	YSCL = 1.0
    	FUNI = 720.0	!10 TIME BLOWUP
     	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)
C
C  SET ACTIVE PLOTTING STYLUS...
C
     	LTY = 1
     	LWD = 1
     	IF( IRR.GT.4 .AND. ARRAY(5).GT.0.0 ) LWD = ARRAY(5)
        WIDE = 0.25*LWD
        LWD  = 1
     	WRITE(LUN,1000) WIDE
1000	FORMAT('%PostScript Plot File (Coordinates: 72 units/inch)'/
     +'/l {lineto} def'/'/m {moveto} def'/'0.0 setgray '
     +,F4.1,' setlinewidth [] 0 setdash 1 setlinejoin')
C
C  SET PLOT ROTATION IF DESIRED...
C
     	IF( IRR.GT.5 .AND. ARRAY(6).NE.0.0 ) THEN
      	    WRITE(LUN,1004)
1004	FORMAT('30 30 translate 0 rotate')
     	ELSE
     	    WRITE(LUN,1005)
1005	FORMAT('585 30 translate 90 rotate')
     	ENDIF
C
C  MOVE TO THE ORIGIN...
C
     	NVEC = 0
     	LINE = 0
999	RETURN
    	END

     	SUBROUTINE IFINIT_PLOT( XORG, YORG )
C
C	THIS ROUTINE INITIALIZES A PLOT SESSION.
C
     	INCLUDE 'PSFILE.CBS'

     	IXO = JXO + INT(XORG*FUNI)
     	IYO = JYO + INT(YORG*FUNI)
     	IXL = IXO
     	IYL = IYO
     	ILP = 1
     	IFN = 1
     	IFP = 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 IFPLOT( 0.0, 0.0, 3 )
     	RETURN
     	END

     	SUBROUTINE IFMARK( ICODE, IR, ARRAY )
C
C   PROGRAMMER: R.S. ZHOU,		ALFRED UNIVERSITY
C
C	THIS ROUTINE DRAWS THE MARKER SYMBOLS USING "IFPLOT" 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 'PSFILE.CBS'
     	DIMENSION	ARRAY(1)

     	IRR = IABS(IR)
     	RAD = 0.5*ARRAY(1)
    	IF( RAD.LT.0.005 ) RAD = 0.005
C
C  SOLID LINE ONLY FOR DRAWING SYMBOLS...
C
     	LTYOLD = LTY
     	IF( LTY.GT.0 ) CALL IFSTYL(1,0)
C
C  REORIGIN TO (ARRAY(2),ARRAY(3))...
C
     	CALL IFPLOT( 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

    	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
     	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( -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 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( 0.0, -RAD, 3 )
     	DO I=-80,270,10
     	   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=-80,90,10
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( 0.0, RAD, 3 )
     	DO I=100,270,10
     	   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=100,270,10
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( 0.0, -RAD, 3 )
     	DO I=-80,90,10
     	   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=10,180,10
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( -RAD, 0.0, 3 )
     	DO I=-170,0,10
     	   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=-10,-180,-10
     	   CALL IFPLOT( RAD*COSD(FLOAT(I)), RAD*SIND(FLOAT(I)), 2 )
    	ENDDO
     	CALL IFFILL(0)
     	CALL IFPLOT( -RAD, 0.0, 3 )
     	DO I=170,0,-10
     	   CALL IFPLOT( 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 IFPLOT( 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
     	RRD = WID*SQRT(RD1*RD1+RD2*RD2)
     	WID = RD1 - RRD/RD2
     	RD2 = RD2 - RRD/RD1
     	RD1 = WID
     	WID = 0.0
     	GOTO 111
C
C  RESTORE...
C
222	CALL IFPLOT( 0.0, 0.0, 3 )
     	IF( IRR.GT.5 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.4 ) CALL IFPLOT( -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       IPF =  1: RETURN WITH COORDINATE (X,Y) IN POSTSCRIPT UNITS.
C
     	INCLUDE 'PSFILE.CBS'
     	PARAMETER (SF= 0.1)
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 + 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( IYL.LT.0 ) IYL = 0
        IF( IPN.EQ.1 ) THEN
            XOP = SF*FLOAT(IXL)
            YOP = SF*FLOAT(IYL)
            GOTO 999
        ENDIF
     	IF( NVEC.EQ.8 ) CALL IFPLOT_DUMP(IPN)
     	NVEC = NVEC + 1
     	IF( IPN.EQ.2 ) THEN
     	    ACT(NVEC) = 'l'
     	ELSE
     	    IF( NVEC.GT.1.AND.ACT(NVEC-1).EQ.'m' ) NVEC=NVEC-1
     	    ACT(NVEC) = 'm'
     	ENDIF
     	KXL(NVEC) = IXL
     	KYL(NVEC) = IYL
C
C  KEEP TRACK OF WORKING ORIGIN...
C
888	IF( IPF.LT.0 ) THEN
    	    XORS = XPS
     	    YORS = YPS
    	ENDIF

999	RETURN
    	END

     	SUBROUTINE IFPLOT_DUMP( IPN )
C
C	THIS ROUTINE DUMPS THE SAVE-VECTOR BUFFER.
C
     	INCLUDE 'PSFILE.CBS'
     	PARAMETER (SF= 0.1)

     	IF( NVEC.EQ.1 .AND. ACT(1).EQ.'m' ) RETURN
     	WRITE(LUN,1) (SF*FLOAT(KXL(I)),SF*FLOAT(KYL(I)),ACT(I),I=1,NVEC)
  1	FORMAT(8(2F7.1,X,A1))
     	NVEC = 0
     	LINE = LINE + 1
     	IF( LINE.GT.128 ) THEN
     	    WRITE(LUN,2)
  2	    FORMAT('stroke')
     	    LINE = 0
     	    IF( IPN.EQ.2 ) THEN
     		NVEC = 1
     		KXL(NVEC) = IXL
     		KYL(NVEC) = IYL
     		ACT(NVEC) = 'm'
     	    ENDIF
     	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 'PSFILE.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 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 IFPLOT( 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 IFPLOT( 0.0, 0.0, 3 )
     	IF( IRR.GT.4 .AND. ANG.NE.0.0 ) CALL IFROTA( XANG, YANG )
     	IF( IRR.GT.3 ) CALL IFPLOT( -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 'PSFILE.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 'PSFILE.CBS'

     	ANGX = XANG
     	ANGY = YANG

999	RETURN
     	END

    	SUBROUTINE IFSCAL( XFAC, YFAC )
C
C	THIS ROUTINE SETS THE OVERALL PLOT SCALE FACTORS.
C
    	INCLUDE 'PSFILE.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 'PSFILE.CBS'

    	XFAC = XSCL
    	YFAC = YSCL

999	RETURN
    	END

      SUBROUTINE IFSPEN( IPEN )
C
C  PROGRAMMER: R.S. ZHOU	SEP-1986
C
C     THIS ROUTINE SETS THE CURRENT COLOR PARAMETERS
C     IN HUE, SATURATION AND BRIGHTNESS FOR A COLOR
C     POST-SCRIPT LASER PRINTER.
C
      INCLUDE 'PSFILE.CBS'
      REAL*4 CHSB(3,8)
      DATA CHSB(1,1), CHSB(2,1), CHSB(3,1) / 0.00, 0.0, 0.0 /  !BLACK
      DATA CHSB(1,2), CHSB(2,2), CHSB(3,2) / 0.33, 0.5, 1.0 /  !RED
      DATA CHSB(1,3), CHSB(2,3), CHSB(3,3) / 0.67, 0.5, 1.0 /  !GREEN
      DATA CHSB(1,4), CHSB(2,4), CHSB(3,4) / 0.00, 0.5, 1.0 /  !BLUE
      DATA CHSB(1,5), CHSB(2,5), CHSB(3,5) / 0.83, 0.5, 1.0 /  !CYAN
      DATA CHSB(1,6), CHSB(2,6), CHSB(3,6) / 0.17, 0.5, 1.0 /  !PURPLE
      DATA CHSB(1,7), CHSB(2,7), CHSB(3,7) / 0.50, 0.5, 1.0 /  !YELLOW
      DATA CHSB(1,8), CHSB(2,8), CHSB(3,8) / 0.00, 0.0, 1.0 /  !WHITE
C
C   ON A BLACK AND WRITE DEC LN03R SCRIPT PRINTER, THE BRIGHTNESS
C   PARAMETER OF POSTSCRIPT COLOR COMMAND "SETHSB" IS SIMULATED WITH 
C   HALFTONE, WHICH IS UNDESIRABLE IN MOST CASES.
C   THEREFORE FOLLOWING LINES ARE COMMENTED OUT.
C
C   HOWEVER THIS HALFTONE EFFECT MAY BE USEFUL IN ACCOMPLISHING
C   HALFTONE LINE DRAWINS ON GRAY BACKGROUND...
C
C      IF( IPEN.NE.0 .AND. IABS(IPEN).LT.9 ) THEN
C          ILP = IPEN
C          WRITE(LUN,1) (CHSB(I,IABS(ILP)),I=1,3)
C  1       FORMAT(3F5.2,' sethsbcolor')
C      ENDIF
      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: LONG DASH
C		LTYP = 7: 2-DOT CENTER
C		LTYP = 8: LONG-SHORT DASH
C		LTYP = 9: LOOSE DASH
C
C	LWID: ACTIVE LINE WIDTH INDEX.
C
	INCLUDE 'PSFILE.CBS'

     	IF( LTYP.EQ.LTY .AND. LWID.EQ.LWD ) RETURN
     	IF( IABS(LTYP).GT.0 ) THEN
     	    LTY = IABS(LTYP)
     	    IF( LTY.GT.9 ) LTY = 9
     	ENDIF
     	IF( IABS(LWID).GT.0 ) THEN
     	    LWD = IABS(LWID)
     	    IF( LWD.GT.99 ) LWD = 99
     	ENDIF
     	IF( NVEC.GT.0 ) CALL IFPLOT_DUMP(0)
     	IF( LINE.GT.0 ) WRITE(LUN,4321)
4321	FORMAT('stroke')
     	WRITE(LUN,1000) WIDE*LWD
1000	FORMAT(F4.1,' setlinewidth')
     	I1 = WIDE*LWD+0.51	!DOT
     	IF( I1.LT.1 ) I1 = 1
     	I2 = 2*I1		!SHORT DASH AND SPACING
     	I4 = 4*I1		!MEDIUM DASH
     	I8 = 8*I1		!LONG DASH
     	IF( LTY.EQ.1 ) THEN	                !SOLID LINE
     	    WRITE(LUN,1001)
     	ELSE IF( LTY.EQ.2 ) THEN
     	    WRITE(LUN,1002) I1, I2		!DOTTED LINE
     	ELSE IF( LTY.EQ.3 ) THEN
     	    WRITE(LUN,1003) I4, I2, I1, I2	!ONE-DOT CENTER
     	ELSE IF( LTY.EQ.4 ) THEN
     	    WRITE(LUN,1002) I2, I2		!SHORT DASH
     	ELSE IF( LTY.EQ.5 ) THEN		!MEDIUM DASH
     	    WRITE(LUN,1002) I4, I2
     	ELSE IF( LTY.EQ.6 ) THEN		!LONG DASH
     	    WRITE(LUN,1002) I8, I2
     	ELSE IF( LTY.EQ.7 ) THEN
     	    WRITE(LUN,1004) I4,I2,I1,I2,I1,I2	!2-DOT CENTER
     	ELSE IF( LTY.EQ.8 ) THEN
     	    WRITE(LUN,1003) I4,I2,I2,I2		!LONG-SHORT DASH
     	ELSE IF( LTY.EQ.9 ) THEN
     	    WRITE(LUN,1002) I4,I4		!SPARSE DASH
     	ENDIF
1001    FORMAT(' [] 0 setdash')
1002	FORMAT(' [',2I3,'] 0 setdash')
1003	FORMAT(' [',4I3,'] 0 setdash')
1004	FORMAT(' [',6I3,'] 0 setdash')
     	LINE = 0
999	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 'PSFILE.CBS'
     	PARAMETER (SF= 0.1, FP= 150.0)
    	CHARACTER	TEXT(1)*1, FONT*2
     	DIMENSION	ARRAY(1)
     	INTEGER		SFONT(99,3)
     	SAVE		SFONT

     	IF( NCHS.EQ.0 ) RETURN
     	IRR = IR
     	IF( NVEC.GT.0 ) CALL IFPLOT_DUMP(0)
C
C  GET THE FONT SIZE...
C
     	IFS = 12
     	IF( IRR.GT.2 .AND. ARRAY(3).GT.0.0 ) THEN
     	    IFS  = INT(FP*ARRAY(3))
     	    IF( IFS.LT.1 ) IFS = 1
     	    IF( IFS.GT.99 ) IFS = 99
     	ENDIF
     	IF( IFN.EQ.1 ) FONT = 'hs'	!HELVETICA
     	IF( IFN.EQ.2 ) FONT = 'ho'	!HELVETICA-OBLIQUE
     	IF( IFN.EQ.3 ) FONT = 'hb'	!HELVETICA-BOLD
     	K = 1
     	IF( IFS.GT.9 ) K = 2
     	IF( SFONT(IFS,IFN).NE.IFS ) THEN
     	    SFONT(IFS,IFN) = IFS
     	    IF( IFN.EQ.1 ) WRITE(LUN,222) IFS,IFS,IFS,IFS
222	    FORMAT(
     +'/fs',I<K>,' /Helvetica findfont ',I<K>,' scalefont def'/
     +'/hs',I<K>,' {moveto fs',I<K>,' setfont show} def')
     	    IF( IFN.EQ.2 ) WRITE(LUN,223) IFS,IFS,IFS,IFS
223	    FORMAT(
     +'/fo',I<K>,' /Helvetica-Oblique findfont ',I<K>,' scalefont def'/
     +'/ho',I<K>,' {moveto fo',I<K>,' setfont show} def')
     	    IF( IFN.EQ.3 ) WRITE(LUN,224) IFS,IFS,IFS,IFS
224	    FORMAT(
     +'/fb',I<K>,' /Helvetica-Bold findfont ',I<K>,' scalefont def'/
     +'/hb',I<K>,' {moveto fb',I<K>,' setfont show} def')
     	ENDIF
C
C  SET LABELING ANGLE...
C
     	ANGLE = 0.0
     	IF( IRR.GT.4 ) THEN
    	    ANGLE = AMOD( ARRAY(5)+XANG, 360.0 )
    	    IF( ANGLE.NE.0.0 ) WRITE(LUN,500) ANGLE
  500       FORMAT(F7.2,' rotate')
     	ENDIF
C
C  GET LABEL POSITION...
C
     	XPS = ARRAY(1)
     	YPS = ARRAY(2)
     	IF( XANG.NE.0.0 .OR. YANG.NE.0.0 ) THEN
     	    XOP = XPS*XCTH-YPS*YSTH
     	    YPS = XPS*XSTH+YPS*YCTH
     	    XPS = XOP
     	ENDIF
     	XPS = SF*(FLOAT(IXO)+FUNI*(XORS+XSCL*XPS))
     	YPS = SF*(FLOAT(IYO)+FUNI*(YORS+YSCL*YPS))
     	IF( ANGLE.NE.0.0 ) THEN
     	    CTH = COSD(ANGLE)
            STH = SIND(ANGLE)
            XOP = XPS*CTH+YPS*STH
     	    YPS = YPS*CTH-XPS*STH
     	    XPS = XOP
     	ENDIF
C
C  WRITE THE LABEL OUT...
C
     	WRITE(LUN,1000) (TEXT(I),I=1,NCHS), XPS, YPS, FONT, IFS
1000	FORMAT('(',<NCHS>A1,')',2F7.1,X,A2,I<K>)
     	IF( ANGLE.NE.0.0 ) WRITE(LUN,500) -ANGLE

999	RETURN
    	END

