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

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

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

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

    	RETURN
    	END

    	SUBROUTINE IFPACK_REGIS( IXY )

    	INCLUDE 'TEKLIB.CBS'

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

    	IN = IABS(IXY)
    	ENCODE( 4, 1, TEXT ) IN
1	FORMAT(I4)
    	DO I=1, 4
    	  IF( TEXT(I).GT.47 ) THEN
    	      IPL = IPL + 1
    	      IPB(IPL) = TEXT(I)
     	  ENDIF
     	ENDDO

    	RETURN
    	END

    	SUBROUTINE IFPACK_INTTEK( BUFFER, IT )
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, NOV-18,1987
C
C	THIS ROUTINE DECODES AN INTEGER REPORT.
C
C	BUFFER -- 3 BYTE BUFFER CONTAINING THE REPORT
C	IT ------ DECODED INTEGER
C
    	BYTE BUFFER(3)

    	IHI = BUFFER(1) - 32
    	IHJ = BUFFER(2) - 32
    	ILI = BUFFER(3) - 32
    	IT  = IHI*1024 + IHJ*16 + ILI-16*(ILI/16)
    	ILI = ILI/16
    	ILI = ILI - 2*(ILI/2)
    	IF( ILI.EQ.0 ) IT = -IT

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

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

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

    	RETURN
    	END

