      SUBROUTINE LIBNAM( BUF )
      CHARACTER*(*) BUF
      BUF = 'TKLIBR'
      RETURN
      END
      SUBROUTINE START(X,Y)
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
      DIMENSION ITERM(4)
C *
C *  SET PLOT MAXIMUMS.  PLOT CAN BE NO LARGER THAN 1023 X 1023 PLOTTER UNITS.
      A=9.25
      IXM=IUNIT(A)
      B=7.0
      IYM=IUNIT(B)
C *
C *  ATTACH THE OUTPUT LINE AND SET LINE CHARACTERISTICS.
    9 LUN=2
	OPEN(UNIT=LUN,FILE='TT:',RECL=1050,CARRIAGECONTROL='NONE',
     + STATUS='NEW')
C      I=MTATCH(LUN,0)
C      IF(I.EQ.0) GO TO 6
C      CALL MTERR(I)
C      STOP
C6     I=MTGET(LUN,ITERM)
C      IF(I.EQ.0) GO TO 7
C      CALL MTERR(I)
C      STOP
C POOF HERE'S A LITTLE BLACK MAGIC.
C7     ITERM(1)=24333
C      I=MTSET(LUN,ITERM)
C      IF(I.EQ.0) GO TO 8
C      CALL MTERR(I)
C      STOP
C *
C *  ASSURE ORIGIN IS WITHIN PLOT DIMENSIONS
8     IF(X.LT.A .AND. X.GE.0.0) GO TO 11
      WRITE(7,1)
    1 FORMAT(' BAD X ORIGIN 0.0 USED.')
      X = 0.0
   11 IF(Y.LT.B .AND. Y.GE.0.0) GO TO 12
      WRITE(7,2)
    2 FORMAT(' BAD Y ORIGIN 0.0 USED.')
      Y = 0.0
C *  INIT COMMON
12    DO 10 I=1,1050
10    IBUFF(I)=0
      LAST=0
      IXO=0
      IYO=0
      IXC=0
      IYC=780
      IPF=3
      CALL FACTOR(1.0)
      IDIM=1000
C *  SET TEKTRONIX 4107 TO 4010 MODE
	IBUFF(LAST+1) = 27	! CODE TEK
	IBUFF(LAST+2) = 37
	IBUFF(LAST+3) = 33
	IBUFF(LAST+4) = 48
	IBUFF(LAST+5) = 27	! DAVISIBILITY NO
	IBUFF(LAST+6) = 76
	IBUFF(LAST+7) = 86
	IBUFF(LAST+8) = 48
	IBUFF(LAST+9) = 27	! DAENABLE NO
	IBUFF(LAST+10) = 75
	IBUFF(LAST+11) = 65
	IBUFF(LAST+12) = 48
	LAST = LAST + 12
C *  INITIALIZE THE SCOPE AND PUT IT IN GRAPHICS MODE
      IBUFF(LAST+1)=27
      IBUFF(LAST+2)=12
      IBUFF(LAST+3)=29
      LAST=LAST+3
C *  MOVE PEN TO ORIGIN  (X,Y,-3)
      CALL PLOT(X,Y,-3)
C *  INITIALIZE COLORS
	CALL PEN(0)
C *  FORCE IBUFF OUT TO PLOTTER.
      CALL BUFOUT
C *  CALL PAUSE TO GIVE SCREEN A CHANCE TO RECOVER FROM INITIALIZATION
      CALL PAUSE(3)
      RETURN
      END
C ***  SUBROUTINE FACTOR
C *
C *  SET VALUE FOR RELATIVE SCALING FACTOR
C *
      SUBROUTINE FACTOR(RSFNEW)
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
      RF = RSFNEW*0.8
      RETURN
      END
      SUBROUTINE PAGE
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
      IXO = 0
      IYO = 0
      CALL PLOT(0.,0.,3)
      CALL ALFMOD
      WRITE(LUN,1)
1     FORMAT(' HIT RETURN FOR NEXT PLOT')
      READ(LUN,'(A1)',END=400) JUNK
      CALL ERASE
400   RETURN
      END
      SUBROUTINE END(DUM)
      CALL EPLOT
      RETURN
      END
      SUBROUTINE EPLOT(DUM)
C *
C *  ERASES THE TEKRONIX SCREEN AND TERMINATES PLOTTING
C *
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C *  OUTPUT <ESC> <FF> <GS> TO ERASE AND ENTER GRAPHICS MODE
	IXO = 0
	IYO = 0
	CALL PLOT(0.,0.,3)
	CALL ALFMOD
	WRITE(LUN,1)
1	FORMAT(' HIT RETURN TO CLEAR SCREEN ')
	READ(LUN,'(A1)',END=400) JUNK
400	CONTINUE
      IBUFF(LAST+1)=27
      IBUFF(LAST+2)=12
      IBUFF(LAST+3)=29
      LAST=LAST+3
C *  MOVE TO THE TOP OF THE PAGE
      IBUFF(LAST+1)=29
      LAST=LAST+1
      CALL ICONVT(0,3120)
C *  RETURN TO ALPHANUMERIC MODE
      CALL ALFMOD
C *  SET THE TEKTRONIX 4107 BACK TO ANSI MODE
	IBUFF(LAST+1) = 27	! DAENABLE YES
	IBUFF(LAST+2) = 75
	IBUFF(LAST+3) = 65
	IBUFF(LAST+4) = 49
	IBUFF(LAST+5) = 27	! DAVISIBILITY YES
	IBUFF(LAST+6) = 76
	IBUFF(LAST+7) = 86
	IBUFF(LAST+8) = 49
	IBUFF(LAST+9) = 27	! CODE ANSI
	IBUFF(LAST+10) = 37
	IBUFF(LAST+11) = 33
	IBUFF(LAST+12) = 49
	LAST = LAST + 12
C *  FORCE IBUFF OUT TO PLOTTER.
      CALL BUFOUT
C *  CALL PAUSE TO GIVE SCREEN A CHANCE TO RECOVER FROM INITIALIZATION
      CALL PAUSE(3)
C *  CLOSE OUTPUT CHANNEL
      CLOSE(LUN)
      RETURN
      END
      SUBROUTINE PEN( NPEN )
C
C  ROUTINE TO SET PEN COLOR(+NPEN) , OR
C              SCREEN COLOR(-NPEN)
C
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C
C  IF BUFFER IS FULL, DUMP IT...
C
      IF(LAST.GE.IDIM) CALL BUFOUT
C
C   COLOR -  SCREEN, DEFAULT, PEN
C
      IF (NPEN) 100, 150, 200
C
  100 NP=-NPEN
C
C  IF SCREEN NUMBER IS OUT OF RANGE, RESET IT.
C
      IF(NP.LT.1) NP=1
      IF(NP.GT.16) NP=16
C
C  SCREEN COLOR IS NPEN
C
	ISC = NP
C
C  SET THE COLOR AND RETURN.
C
	IBUFF(LAST+1) = 27
	IBUFF(LAST+2) = 77
	IBUFF(LAST+3) = 66
	IBUFF(LAST+4) = 48 + ISC
	IBUFF(LAST+5) = 33
	LAST = LAST + 5
C
      GO TO 300
C
C  DEFAULT CONDITION - SETS SCREEN BLACK AND PEN WHITE.
C
150	IBUFF(LAST+1) = 27
	IBUFF(LAST+2) = 77
	IBUFF(LAST+3) = 66
	IBUFF(LAST+4) = 48
	IBUFF(LAST+5) = 33
	LAST = LAST + 5
C
	IBUFF(LAST+1) = 27
	IBUFF(LAST+2) = 77
	IBUFF(LAST+3) = 76
	IBUFF(LAST+4) = 49
	LAST = LAST + 4
C
      GO TO 300
C
C  SET PEN COLOR AND RETURN.
C
  200 IF(NPEN.LT.1) NPEN= 1
      IF(NPEN.GT.16) NPEN= 16
C
C  PEN COLOR IS NPEN
C
      IPC=NPEN
C
	IBUFF(LAST+1) = 27
	IBUFF(LAST+2) = 77
	IBUFF(LAST+3) = 76
	IBUFF(LAST+4) = 48 + IPC
	LAST = LAST + 4
C
  300 RETURN
      END
      SUBROUTINE PLOT(XDUM,YDUM,IPEN)
C *
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C *
C *  IF BUFFER IS FULL... SEND IT
      IF(LAST.GE.IDIM) CALL BUFOUT
C *
C *  CONVERT COORDINATES TO PLOTTER UNITS
      IX=IUNIT(XDUM*RF)
      IY=IUNIT(YDUM*RF)
C *  X,Y BECOME POINT OF NEW PEN LOCATION, CHECK FOR 'SAME AS LAST',
C *  SOFT GRAPH LIMITS
      IF(XDUM.EQ.999.)IX=IXC
      IF(YDUM.EQ.999.)IY=IYC
C *
C *  CHECK FOR OUT OF LIMITS CONDITIONS
      IF(IX+IXO.GT.IXM)IX=IXM-IXO
      IF(IX+IXO.LT.0)IX=0-IXO
      IF(IY+IYO.GT.IYM)IY=IYM-IYO
      IF(IY+IYO.LT.0)IY=0-IYO
C *
C *  CHECK IPEN FOR CHANGE OF POSITION VALUES
      IF(IPEN.EQ.1.OR.IPEN.EQ.999)IPEN=IPF
      IF(IPEN.EQ.-1.OR.IPEN.EQ.-999)IPEN=-IPF
      IPF=IABS(IPEN)
C *
C *  IF IPF = 3 THEN BUFFER A (GS) FOR A DARK VECTOR
      IF(IPF.NE.3) GO TO 5
      IBUFF(LAST+1)=29
      LAST=LAST+1
C *  DETERMINE FUNCTION: MOVE/DRAW TO/FROM NEW/OLD ORIGIN
5     IF(IPEN)20,10,10
C *
C *  IPEN > 0.  NO ORIGIN SHIFT TO TAKE PLACE.  ALL MOVES RELATIVE
C *  TO ORIGIN.  IPEN = 2 DRAW, IPEN = 3 MOVE.
C *
C *  DEFINE ABSOLUTE COORDINATES FOR MOVE OR DRAW
10    IXV = IX + IXO
      IYV = IY + IYO
      CALL ICONVT(IXV,IYV)
C *  UPDATE CURRENT COORDINATES WITH RESPECT TO THE ORIGIN
      IXC = IX
      IYC = IY
      GO TO 30
C *
C *  IPEN < 0.  NEW ORIGIN DEFINITION TAKING PLACE. DEFINE ORIGIN WITH
C *  RESPECT TO OLD ORIGIN.  IPEN = -2 DRAW, IPEN = -3 MOVE.
C *
C *  DEFINE ORIGIN WITH RESPECT TO OLD ORIGIN
20    IXO=IXO+IX
      IYO=IYO+IY
C *  LOAD MOVE OR DRAW INSTRUCTION AND COORDINATES
      CALL ICONVT(IX,IY)
C *  UPDATE CURRENT PEN POSITION
      IXC=0
      IYC=0
C *
C *  BUFFER READY TO SEND
30    RETURN
      END
C ***  SUBROUTINE SYMBOL
C *
C *  SUBROUTINE SYMBOL HANDLES THE TEXT AND SYMBOL GENERATION
C *
      SUBROUTINE SYMBOL(XPAGE,YPAGE,HGHT,IBCD,ANGLE,NCHAR)
C *
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
      DIMENSION XSC(30), YSC(30)
      CHARACTER*1 IBCD(2), IBLANK
      BYTE IBUFF
      DATA IBLANK/' '/
C *
C * IF NCHAR < 0; IT'S A SPECIAL SYMBOL CALL.
      IF(NCHAR.LT.0) GO TO 25
C *  GET NUMBER OF CHARACTERS IN IBCD.  TRAILING BLANKS ARE REMOVED SO
C *  THIS NUMBER MAY VARY FROM WHAT THE USER PASSES.
      DO 10 I=NCHAR,1,-1
      IF( IBCD(I).NE.IBLANK ) GO TO 20
10    CONTINUE
C *  ALL BLANK CHARACTERS WERE FOUND IN IBCD.  TERMINATE.
      GO TO 900
C *  STORE CORRECT CHARACTER COUNT
20    NTRUE=I
C * DETERMINE SPACIAL SHIFT BETWEEN CHARACTERS
      HT=HGHT*RF
      IF(HT.LT..16/RF)HT=.16/RF
      A=HT*.7
      O=HT
      DX=1.
      DY=1.
      ANG=ANGLE
35    IF(ANG.LT.360.)GO TO 40
      ANG=ANG-360.
      GO TO 35
40    IF(ANG.LT.270.)GO TO 41
      ANG=360-ANG
      DY=-1.
41    IF(ANG.LT.180.)GO TO 42
      ANG=ANG-180.
      DX=-1.
      DY=-1.
42    IF(ANG.LT.90.)GO TO 43
      ANG=180.-ANG
      DX=-1.
      IF(ANG.EQ.90.) DY=-1.				!DCE
43    IF(ANG.LE.55.)GO TO 44
      ANG=ANG*.01745
      H=O/SIN(ANG)
      A=H*COS(ANG)
      GO TO 45
44    ANG=ANG*.01745
      H=A/COS(ANG)
      O=H*SIN(ANG)
45    DX=DX*A
      DY=DY*O
      X=XPAGE
      Y=YPAGE
      IF(ANG.EQ.90.*.01745) Y=Y-(NTRUE-1)*DY		!DCE
C * PUT OUT CHARACTERS
      DO 50 I=1,NTRUE
      CALL PLOT(X,Y,3)
      CALL ALFMOD
      IBUFF(LAST+1)=ICHAR(IBCD(I))
      LAST=LAST+1
      IF(LAST+10.GE.IDIM)CALL BUFOUT
      X=X+DX
      Y=Y+DY
50    CONTINUE
C *  ALL CHARACTERS OUT...
      GO TO 800
C *
C *  SPECIAL SYMBOL CALL: ONLY 0-11 ARE ALLOWED.
C *
C *  INSURE SYMBOL CODE IS WITHIN LIMITS
25    ISYM = ICHAR( IBCD(1) )
      IF(ISYM.GT.11) ISYM = 11
      IF(ISYM.LT.0) ISYM = 0
C *  MOVE TO XPAGE, YPAGE
      ICODE=2
      IF(NCHAR.EQ.-1) ICODE=3
      CALL PLOT(XPAGE,YPAGE,ICODE)
C *  IF IBCD(1) = 0 THEN DO NOT DRAW A SYMBOL
      IF(ISYM.EQ.0) GO TO 900
C *  SET LABEL SIZE
      HT=HGHT*RF
      RADIUS=HT/2.
      FULL=HT
      HALF=HT/2.
      THIRD=HT/3.
      GO TO (110,210,120,130,140,150,160,220,230,240,170),ISYM
C * DRAW A CIRCLE
110   ISTART=0
      IEND=ISTART+360
      INCR=30
      GO TO 500
C * DRAW A TRIANGLE
120   ISTART=90
      IEND=ISTART+360
      INCR=120
      GO TO 500
C * DRAW A SQUARE
130   ISTART=45
      IEND=ISTART+360
      INCR=90
      GO TO 500
C * DRAW A STAR
140   ISTART=90
      IEND=ISTART+720
      INCR=144
      GO TO 500
C * DRAW A DIAMOND
150   ISTART=90
      IEND=ISTART+360
      INCR=90
      GO TO 500
C * DRAW A VIRTICAL BAR
160   ISTART=90
      IEND=ISTART+180
      INCR=180
      GO TO 500
C * DRAW A DEL
170   ISTART=270
      IEND=ISTART+360
      INCR=120
      GO TO 500
C * DRAW AN X
210   ITEM = 5
      XSC(1) = XPAGE - HALF
      YSC(1) = YPAGE + HALF
      XSC(2) = XPAGE + HALF
      YSC(2) = YPAGE - HALF
      XSC(3) = XPAGE
      YSC(3) = YPAGE
      XSC(4) = XPAGE + HALF
      YSC(4) = YPAGE + HALF
      XSC(5) = XPAGE - HALF
      YSC(5) = YPAGE - HALF
      GO TO 700
C * DRAWN CROSS
220   ITEM = 5
      XSC(1) = XPAGE
      YSC(1) = YPAGE - HALF
      XSC(2) = XPAGE
      YSC(2) = YPAGE + HALF
      XSC(3) = XPAGE
      YSC(3) = YPAGE
      XSC(4) = XPAGE + HALF
      YSC(4) = YPAGE
      XSC(5) = XPAGE - HALF
      YSC(5) = YPAGE
      GO TO 700
C * DRAW UP ARROW
230   ITEM = 5
      XSC(1) = XPAGE
      YSC(1) = YPAGE - HALF
      XSC(2) = XPAGE
      YSC(2) = YPAGE + HALF
      XSC(3) = XPAGE + THIRD
      YSC(3) = YPAGE
      XSC(4) = XPAGE
      YSC(4) = YPAGE + HALF
      XSC(5) = XPAGE - THIRD
      YSC(5) = YPAGE
      GO TO 700
C * DRAW DOWN ARROW
240   ITEM = 5
      XSC(1) = XPAGE
      YSC(1) = YPAGE + HALF
      XSC(2) = XPAGE
      YSC(2) = YPAGE - HALF
      XSC(3) = XPAGE + THIRD
      YSC(3) = YPAGE
      XSC(4) = XPAGE
      YSC(4) = YPAGE - HALF
      XSC(5) = XPAGE - THIRD
      YSC(5) = YPAGE
      GO TO 700
C *
500   ITEM=0
      DO 600 I=ISTART,IEND,INCR
      B=FLOAT(I)*.01745
      ITEM=ITEM+1
      FMXSC=RADIUS*COS(B)
      FMYSC=RADIUS*SIN(B)
      XSC(ITEM)=FMXSC + XPAGE
600   YSC(ITEM)=FMYSC + YPAGE
C *
700   CALL PLOT(XSC(1),YSC(1),3)
      DO 750 I=2,ITEM
750   CALL PLOT(XSC(I),YSC(I),2)
C *
C *  RETURN TO ORIGINAL XPAGE,YPAGE COORDINATES
800   CALL PLOT(XPAGE,YPAGE,3)
C *
C *  TASK COMPLETE
900   RETURN
      END
C ***  SUBROUTINE NUMBER
C *
C *  HOMEBREW NUMBER ROUTINE.  FOLLOWS SAME RULES AS THOSE OF CALCOMP.
C *
      SUBROUTINE NUMBER(XPAGE,YPAGE,HEIGHT,FPN,ANGLE,NDEC)
C *
      CHARACTER LOC(20)*1, BLANK*1 ,DP*1
      DATA BLANK/' '/
      DATA DP/'.'/
C *
C *  ROUND THE FPN TO THE NEAREST NDEC DECIMAL PLACE
      XFPN = FPN
      NDXP = NDEC
      IF(NDEC.LT.0) NDXP = IABS( NDEC ) - 1
      IF(FPN.GT.0.0) XFPN = XFPN + 0.5*10.**(-NDXP)
      IF(FPN.LT.0.0) XFPN = XFPN - 0.5*10.**(-NDXP)
C *
C ENCODE THE FLOATING POINT NUMBER INTO 'A' FORMAT.
      ENCODE(20,1000,LOC(1)) XFPN
1000  FORMAT(F20.6)
C FIND THE FIRST NON BLANK CHARACTER.
      DO 10 I=1,20
10    IF(LOC(I).NE.BLANK) GO TO 15
C ALL BLANK CHARACTERS. HMMMM. PROBLEMS. GIVE IT UP.
      J2=20
      GO TO 45
C SHIFT THE LOC ARRAY LEFT AND FIND DECIMAL POINT LOCATION.
15    K=1
      IDP=20
      DO 20 J=I,20
      LOC(K)=LOC(J)
      LOC(J)=BLANK
      IF(LOC(K).EQ.DP) IDP=K
      K=K+1
20    CONTINUE
C NOW PROCESS THE LOC ARRAY POINTERS FOR THE DESIRED OUTPUT.
      IF(NDEC) 25,35,40
C NDEC NEGATIVE. IF NDEC=-1 OUTPUT THE INTEGER PORTION OF THE NUMBER.
C WITH OUT THE DECIMAL POINT.
25    IF(NDEC.NE.-1) GO TO 30
      J2=IDP-1
      GO TO 45
C IF NDEC<-1 OUTPUT IABS(NDEC)-1 DIGITS FROM THE NUMBER.
30    J2=IABS(NDEC)-1
C DON'T FORGET THE MINUS SIGN IF PRESENT.
      IF(FPN.LT.0.0) J2=J2+1
      GO TO 45
C NDEC=0.  PRINT OUT THE INTEGER PORTION OF THE NUMBER WITH DEC. PT.
35    J2=IDP
      GO TO 45
C PRINT OUT NDEC DIGITS TO THE RIGHT OF THE DECIMAL POINT.
40    J2=IDP+NDEC
45    DO 50 I=J2+1,20
      LOC(I)=BLANK
50    CONTINUE
      CALL SYMBOL(XPAGE,YPAGE,HEIGHT,LOC,ANGLE,J2)
      RETURN
      END
      SUBROUTINE TICKS(X,Y,XAL,YAL)
C
C PROGRAMMER: C.L. MALLORY
C             ALFRED UNIVERSITY
C
C ROUTINE TO PLACE TICK MARKS ON RIGHT AND TOP SIDES OF GRAPH BOX.
C
C ARGUMENT DEFINITIONS:
C
C X,Y - LOCATION OF THE POINT IN COMMON BETWEEN THE
C       CURRENT X AND Y AXIS TO BE TICKED.
C XAL,YAL - X AXIS AND Y AXIS LENGTHS.
C
C LOCAL VARIABLES:
C TL - THE LENGTH OF THE TICK MARK TO BE USED.
C
C
C EXTERNAL SUBROUTINES REQUIRED:
C        PLOT
C
      IXAL=INT( XAL * 2. + .5 )
      IYAL=INT( YAL * 2. + .5 )
      TL=0.07
C TICK THE RIGHT HAND AXIS
	A=1.0
	TK=TL/2.0
	TL=TL-TK
      X1=X+XAL
      CALL PLOT(X1,Y,3)
      DO 10 I=1,IYAL
      Y1=Y+0.5*I
      CALL PLOT(X1,Y1,2)
      CALL PLOT(X1-TL,Y1,2)
      CALL PLOT(X1,Y1,2)
	TL=TL+A*TK
	A=-1.0*A
10    CONTINUE
C TICK THE TOP AXIS.
	TL=0.07
	TK=TL/2.0
	TL=TL-TK
	A=1.0
      Y1=Y+YAL
      CALL PLOT(X1,Y1,3)
      DO 15 I=IXAL-1,0,-1
      X1=X+0.5*I
      CALL PLOT(X1,Y1,2)
      CALL PLOT(X1,Y1-TL,2)
      CALL PLOT(X1,Y1,2)
	TL=TL+A*TK
	A=-1.0*A
15    CONTINUE
      RETURN
      END
      SUBROUTINE AXIS(XPAGE,YPAGE,IBCD,NCHAR,AXLEN,ANGLE,FIRSTV,DELTAV)
C  AXIS     COPYRIGHT 1968 CALIFORNIA COMPUTER PRODUCTS         V048
C.....     XPAGE,YPAGE  COORDINATES OF STARTING POINT OF AXIS, IN INCHES
C.....     IBCD         AXIS TITLE.
C.....     NCHAR        NUMBER OF CHARACTERS IN TITLE. + FOR C.C-W SIDE.
C.....     AXLEN        FLOATING POINT AXIS LENGTH IN INCHES.
C.....     ANGLE        ANGLE OF AXIS FROM THE X-DIRECTION, IN DEGREES.
C.....     FIRSTV       SCALE VALUE AT THE FIRST TIC MARK.
C.....     DELTAV       CHANGE IN SCALE BETWEEN TIC MARKS ONE INCH APART
C TIMTEN CONTAINS THE CODE TO PLOT OUT A LOWER
C CASE 'X' AND THE '10' FOR THE EXPONENT, WHEN PLOTTED.
      CHARACTER IBCD(2)*1, TIMTEN(3)*1
      DATA TIMTEN/"170,'1','0'/
      KN=NCHAR
      A=1.0
      IF (KN) 1,2,2
  1   A=-A
      KN=-KN
  2   EX=0.0
      ADX= DELTAV
      IF (ADX) 3,7,3
  3   IF (ABS(ADX)- 99.0) 6,4,4
  4   ADX=ADX/10.0
      EX=EX+1.0
      GO TO 3
  5   ADX=ADX*10.0
      EX=EX-1.0
  6   IF (ABS(ADX)-0.01) 5,7,7
  7   XVAL=FIRSTV*10.0**(-EX)
      ADX= DELTAV*10.0**(-EX)
      STH=ANGLE*0.0174533
      CTH=COS(STH)
      STH=SIN(STH)
      DXB=-0.1
C      DYB=0.15*A-0.05
      DYB=0.22*A-0.05
      XN=XPAGE+DXB*CTH-DYB*STH
      YN=YPAGE+DYB*CTH+DXB*STH
      NTIC=AXLEN+1.0
      NT=NTIC/2
C
C A HOMEBREW PATCH TO ALLOW 0, 1-3 DECIMAL POINTS RATHER THAN
C ALWAYS HAVING ONE SET VALUE.
C CHECKS BOTH THE BEGINNING VALUE (XVAL) AND THE INCREMENT (ADX).
C
      DIGIT=XVAL
      NNDIGS = -99
      DO 10 J=1,2
      DIGIT=ABS(AINT((DIGIT-AINT(DIGIT))*1000.0+.5))
      IF(DIGIT.GT.0.0) NDIGIT=3
      IF(DIGIT.EQ.AINT(DIGIT/10.)*10.) NDIGIT=2
      IF(DIGIT.EQ.AINT(DIGIT/100.)*100.) NDIGIT=1
      IF(DIGIT.EQ.AINT(DIGIT/1000.)*1000.) NDIGIT=-1
      IF(DIGIT.EQ.0.0) NDIGIT=-1
      DIGIT=ABS(ADX)
      IF(NDIGIT.GT.NNDIGS) NNDIGS = NDIGIT
10    CONTINUE
      NDIGIT = NNDIGS
C.....
	FIRSTX=0.03*CTH
	FIRSTY=0.03*STH
      DO  20  I=1,NTIC
        CALL NUMBER(XN+FIRSTX,YN+FIRSTY,0.105,XVAL,ANGLE,NDIGIT)
	FIRSTX=0.0
	FIRSTY=0.0
        XVAL=XVAL+ADX
        XN=XN+CTH
        YN=YN+STH
        IF (NT) 20,11,20
 11       Z=KN
          IF (EX)  12,13,12
 12       Z=Z+7.0
          IF (ANGLE.EQ.90.) Z=Z-14		!DCE
 13       DXB=-.07*Z+AXLEN*0.5
C          DYB=0.325*A-0.075
          DYB=0.55*A-0.075			!DCE
          XT=XPAGE+DXB*CTH-DYB*STH
          YT=YPAGE+DYB*CTH+DXB*STH
          CALL SYMBOL(XT,YT,0.14,IBCD(1),ANGLE,KN)
          IF (EX)  14,20,14
 14         Z=KN+2
            IF (ANGLE.EQ.90.) Z=-5		!DCE
            XT=XT+Z*CTH*0.14
            YT=YT+Z*STH*0.14
C NOTE EARLIER COMMENTS FOR TIMTEN
            CALL SYMBOL(XT,YT,0.14,TIMTEN,ANGLE,3)
C MY PATCH. PREVENTS PLOTTING A '1' FOR EXPONENTS EQUAL TO '1'.
C LEAVES IT LOOKING LIKE 'X10' INSTEAD OF 'X10^1'.
            IF(EX.EQ.1.0) GO TO 20
            IF (ANGLE.EQ.90.) THEN		!DCE
               XT=XT+0.8*0.14			!DCE
               YT=YT-0.14			!DCE
               ELSE				!DCE
               XT=XT+(3.0*CTH-0.8*STH)*0.14
               YT=YT+(3.0*STH+0.8*CTH)*0.14
               END IF				!DCE
            CALL NUMBER(XT,YT,0.07,EX,ANGLE,-1)
 20   NT=NT-1
      CALL PLOT(XPAGE+AXLEN*CTH,YPAGE+AXLEN*STH,3)
C     DXB=-0.07*A*STH
C     DYB=+0.07*A*CTH
      DXB=0.07*A*STH
      DYB=-0.07*A*CTH
      A=NTIC-1
      XN=XPAGE+A*CTH
      YN=YPAGE+A*STH
	DX=DXB/2.0
	DY=DYB/2.0
	CTH=CTH/2.0
	STH=STH/2.0
	A=-1.0
      DO  30  I=1,NTIC*2-1
        CALL PLOT(XN,YN,2)
        CALL PLOT(XN+DXB,YN+DYB,2)
        CALL PLOT(XN,YN,2)
        XN=XN-CTH
        YN=YN-STH
	DXB=DXB+A*DX
	DYB=DYB+A*DY
	A=-1.0*A
 30   CONTINUE
      RETURN
      END

      SUBROUTINE ALFMOD
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C *  IF BUFFER FULL SEND
      IF(LAST.GE.IDIM) CALL BUFOUT
C *
C * SET ALPHA MODE OUTPUT (US)
      IBUFF(LAST+1)=31
      LAST=LAST+1
      CALL BUFOUT
      RETURN
      END
      SUBROUTINE BUFOUT
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C *  IF NO CHARACTERS THEN DONT SEND BUFFER
      IF(LAST.LE.0) GO TO 20
C *
C *  OUTPUT THE BUFFER
C      DO 10 I=1,LAST
C      J=MTOUT(LUN,IBUFF(I))
C      IF(J.NE.O) CALL MTERR(J)
C      IBUFF(I)=0
C10    CONTINUE
	WRITE(LUN,100) (IBUFF(I),I=1,LAST)
100	FORMAT(1050A1$)
C *
20    LAST=0
      RETURN
      END
      SUBROUTINE ERASE
C *
C *  ERASES THE TEKRONIX SCREEN AND WAITS FOR RECOVERY
C *
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C *  OUTPUT <ESC> <FF> <GS> TO ERASE AND ENTER GRAPHICS MODE
      IBUFF(LAST+1)=27
      IBUFF(LAST+2)=12
      IBUFF(LAST+3)=29
      LAST=LAST+3
C *  FORCE IBUFF OUT TO PLOTTER.
      CALL BUFOUT
C *  CALL PAUSE TO GIVE SCREEN A CHANCE TO RECOVER FROM INITIALIZATION
C      CALL PAUSE(3)
      RETURN
      END
      SUBROUTINE ICONVT(IX,IY)
      BYTE IBUFF
      COMMON/TKCMN/ 
     &IBUFF(1050),LAST,IXO,IYO,IXC,IYC,IXM,IYM,IPF,IDIM,RF,LUN
C *  IF BUFFER FULL SEND
      IF(LAST.GE.IDIM) CALL BUFOUT
C *
C *  SET PLOTTING CHARACTERS
      KX=IX
      KY=IY
      IF(KX.LT.0) KX=0
      IF(KY.LT.0) KY=0
      IBUFF(LAST+1)=MOD(KY/128,32)+32
      IBUFF(LAST+2)=MOD(KY,4)*4+MOD(KX,4)+96
      IBUFF(LAST+3)=MOD(KY/4,32)+96
      IBUFF(LAST+4)=MOD(KX/128,32)+32
      IBUFF(LAST+5)=MOD(KX/4,32)+64
      LAST=LAST+5
      RETURN
      END
      FUNCTION IUNIT(A)
C *  SUBROUTINE TO CHANGE INCHES TO PLOTTER UNITS FOR TEKTRONIX PLOTTER
      MAX = 58.
      CFACTR = 546.133333
C *  CHECK FOR POSSIBLE OVERFLOW CONDITIONS.
      IF(A.GT.MAX) A = MAX
      IF(A.LT.-MAX) A = -MAX
C *  CONVERT TO PLOTTER UNITS
      IUNIT=INT( A * CFACTR + .5 )
      RETURN
      END
      SUBROUTINE PAUSE(ISEC)
C      INTEGER ISEC
C THIS ROUTINE CHEWS UP CPU FOR NO. OF SECONDS IN PAUSE
C BECAUSE ISLEEP DOESN'T APPEAR TO WORK
C      INTEGER*2 ITIME(2),HRS,MIN,SEC,TICK,ENDSEC
C      CALL GTIM(ITIME)
C      CALL CVTTIM(ITIME,HRS,MIN,SEC,TICK)
C      ENDSEC=SEC+ISEC
C      IF(ENDSEC.GE.60)ENDSEC=ENDSEC-60
C10    CALL GTIM(ITIME)
C      CALL CVTTIM(ITIME,HRS,MIN,SEC,TICK)
C      IF(SEC.LT.ENDSEC)GO TO 10
      RETURN
      END
