C
C----------SUBROUTINE--INITT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE INITT(IBAUD)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT

C
C     THE FOLLOWING LINES ARE ADDED FOR THE VAX 11-750
C     FOR TERMINAL DEFINITION
C
      CALL CHANNEL
C
C     END OF ADDITION
C
      KBAUDR=IBAUD
      KPAD2=KBAUDR/308+1
      KGNMOD=0
      KPADV=0
      KOBLEN=89
      KTERM=1
      KFACTR=4
C * SET THE OUTPUT BUFFER FORMAT
      CALL SETBUF(3)
      KINLFT=0
      KOTLFT=1
      CALL RESET
      CALL NEWPAG
      RETURN
      END
c
C
C----------SUBROUTINE--TWINDO------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TWINDO(MINX,MAXX,MINY,MAXY)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * DEFINE TERMINAL WINDOW IN TERMINAL COMMON AREA
      KMINSX=MINX
      KMAXSX=MAXX
      KMINSY=MINY
      KMAXSY=MAXY
      CALL RESCAL
      RETURN
      END
c
C
C----------SUBROUTINE--DWINDO------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DWINDO(XMIN,XMAX,YMIN,YMAX)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * DEFINE DATA WINDOW IN TERMINAL COMMON AREA
      TMINVX=XMIN
      TMAXVX=XMAX
      TMINVY=YMIN
      TMAXVY=YMAX
      CALL RESCAL
      RETURN
      END
c
C
C----------SUBROUTINE--POINTA------------------------TEKTRONIX, INC.----
C
      SUBROUTINE POINTA(X,Y)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      CALL LVLCHT
C * CONVERT TO SCREEN CO-ORDINATES
      CALL V2ST(0,X,Y,IX,IY)
C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
      IF(KGNFLG .EQ. 1)GO TO 10
      IF(KKMODE .NE. 2)CALL PNTMOD
      CALL TKPNT(IX,IY)
10    RETURN
      END
c
C
C----------SUBROUTINE--DRAWA-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRAWA(X,Y)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * SET TERMINAL TO DRAW SOLID LINES IF NEEDED
C * THIS SECTION IS NEEDED FOR 4014 ENHANCED ***************************
C      IF(KLINE .EQ. 0)GO TO 5
C      KLINE=0
C      CALL CWSEND
C5     CONTINUE
C **********************************************************************
      CALL LVLCHT
C * CONVERT TO SCREEN CO-ORDINATES
      CALL V2ST(1,X,Y,IX,IY)
C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
      IF(KGNFLG .EQ. 1)GO TO 10
      IF(KKMODE.NE.1)CALL VECMOD
      IF(KMOVEF.EQ.1)CALL XYCNVT(KBEAMX,KBEAMY)
      CALL XYCNVT(IX,IY)
10    RETURN
      END
c
C
C----------SUBROUTINE--SCURSR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SCURSR(ICHAR,IX,IY)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION ICODE(2),IN(5)
      DATA ICODE(1),ICODE(2)/27,26/
C * SET THE GRAPHIC INPUT FLAG
      KGNMOD=1
C * OUTPUT (ESC) (SUB) TO TURN ON CURSOR
      IF(KTERM .GT. 0)CALL TOUTST(2,ICODE)
C * CURSER SHOULD ALWAYS INPUT A NEW BUFFER
      KINLFT=0
      CALL TINSTR(5,IN)
C * REMOVE THE GRAPHIC INPUT FLAG
      KGNMOD=0
C * RESTORE THE TERMINAL STATUS
      CALL RECOVR
      ICHAR=IN(1)
C * DECODE SCREEN CO-ORDINATES
      IX=MOD(IN(2),32)*32+MOD(IN(3),32)
      IY=MOD(IN(4),32)*32+MOD(IN(5),32)
C * APPLY SCREEN SCALE FACTOR
      IX=IX*4/KFACTR
      IY=IY*4/KFACTR
      RETURN
      END
c
C
C----------SUBROUTINE--ERASE-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ERASE
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,12/
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(10)
      CALL RECOVR
      RETURN
      END
c
C
C----------SUBROUTINE--FINITT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE FINITT(IX,IY)
      CALL MOVABS(IX,IY)
      CALL ALFMOD
      CALL TSEND
C     STOP
      RETURN
      END
c
C
C----------SUBROUTINE--MOVABS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE MOVABS(IX,IY)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      CALL VECMOD
      CALL XYCNVT(IX,IY)
      KGRAFL=0
      RETURN
      END
c
C
C----------SUBROUTINE--SETBUF------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SETBUF(KFORM)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      KUNIT=KFORM
C * CHECK FOR OUT OF BOUNDS FORMAT TYPES
      IF(KUNIT .LT. 1)KUNIT=1
      IF(KUNIT .GT. 4)KUNIT=4
C * SET MAXIMUM OUTPT CHAR COUNT DEPENDING ON BUFFER TYPE
      IF(KUNIT .GE. 3) GO TO 1
      KACHAR=KOBLEN-11-KPAD2
      KTRAIL=1
      RETURN
1     KACHAR=KOBLEN
      KTRAIL=0
      RETURN
      END
c
	SUBROUTINE ERRMSG(IERR)
C
	INTEGER*4 LLEN
	INTEGER*4 SYS$GETMSG
	CHARACTER*100 BUFFER
C
	I = SYS$GETMSG(%VAL(IERR),LLEN,BUFFER,%VAL(15),)
	WRITE(6,*) BUFFER(1:LLEN)
	RETURN
	END
C
C----------SUBROUTINE--REVCOT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE REVCOT(IX,IY,X,Y)
      LOGICAL DEC
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      E=2.7182818284
      DX=FLOAT(IX-KMINSX)/TRFACX
      DY=FLOAT(IY-KMINSY)/TRFACY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C *       LINEAR LOG POLAR USER ERROR
      GO TO(300, 400, 500, 600, 100  ),KEY
C * ERROR
100   X=IX
      Y=IY
      GO TO 700
C * LINEAR
300   X=DX+TMINVX
      Y=DY+TMINVY
      GO TO 700
C * LOG SCALES
400   KEYL=TRPAR1
      X=DX+TMINVX
      Y=DY+TMINVY
      IF(KEYL .EQ. 1 .OR. KEYL .EQ. 3)X=E**(DX+TRPAR2)
      IF(KEYL .EQ. 2 .OR. KEYL .EQ. 3)Y=E**(DY+TRPAR3)
      GO TO 700
C * POLAR
500   DX=FLOAT(IX)-TRPAR3
      DY=FLOAT(IY)-TRPAR4
      Y=ATAN2(DY,DX)*57.2957795131
      X=SQRT(DY*DY+DX*DX)/TRFACX+TRPAR5
C * ADJUST ANGLE MOD 2 PI TO VALUE WITHIN WINDOW
      DEC=.FALSE.
510   IF(Y .GT. TRPAR1) GO TO 530
C * INCREMENT ANGLE
      Y=Y+360.0
      GO TO 510
530   IF(Y .LE. TRPAR2) GO TO 550
C * DECREMENT ANGLE
      Y=Y-360.0
      DEC=.TRUE.
      GO TO 530
550   IF(DEC .AND. Y .LT. TRPAR1)Y=Y+360.0
      IF(TMINVX .GE. 0.)GO TO 560
      TR1A=AMOD(TRPAR1+180.,360.)
      TR2A=AMOD(TRPAR2+180.,360.)
      IF(Y.GT.AMAX1(TR1A,TR2A).OR.Y.LT.AMIN1(TR1A,TR2A))GO TO 560
      Y=AMOD(Y+180.,360.)
      X=-X
560   Y=Y/TRFACY+TRPAR6
      GO TO 700
C * USER CONVERSION
600   CONTINUE
C      CALL UREVCT(IX,IY,X,Y)
C * EXIT POINT
700   CALL PCLIPT(X,Y)
      RETURN
      END
c

C
C----------SUBROUTINE--PSCAL-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PSCAL
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      LOGICAL ANEG
      ANEG=TRPAR1 .GT. TRPAR2
C * FLAG THE OLD VIRTUAL COORDINATES AS INCORRECT
      KGRAFL=0
      PIDV2=90.00
C * SET UP UNTRANSLATED TRIAL POLAR WINDOW
      TRPAR3=0.
      TRPAR4=0.
      TRFACY=1.
      TRPAR6=0.
      R1=TMINVX
      R2=TMAXVX
      RMAX=AMAX1(ABS(R1),ABS(R2))
      TRFACX=1000./RMAX
      THMIN=AMIN1(TRPAR1,TRPAR2)
      THMAX=AMAX1(TRPAR2,TRPAR1)
C * FIND EXTREMES OF THE TRIAL POLAR WINDOW
      CALL WINCOT(R1,THMIN,IX1,IY1)
      CALL WINCOT(R1,THMAX,IX2,IY2)
      CALL WINCOT(R2,THMIN,IX3,IY3)
      CALL WINCOT(R2,THMAX,IX4,IY4)
      IXMIN=MIN0(IX1,IX2,IX3,IX4)
      IXMAX=MAX0(IX1,IX2,IX3,IX4)
      IYMIN=MIN0(IY1,IY2,IY3,IY4)
      IYMAX=MAX0(IY1,IY2,IY3,IY4)
      X=THMIN/PIDV2
      IF(THMIN.GT.0.)X=X+.999
      QUAD=FLOAT(IFIX(X))*PIDV2
      NQUAD=0
C * CHECK EXTREMES OF TRIAL WINDOW AT 90 DEGREE INTERVALS
200   IF(QUAD.GE.THMAX)GO TO 300
      NQUAD=NQUAD+1
      CALL WINCOT(R1,QUAD,IX1,IY1)
      CALL WINCOT(R2,QUAD,IX2,IY2)
      IXMIN=MIN0(IX1,IX2,IXMIN)
      IXMAX=MAX0(IX1,IX2,IXMAX)
      IYMIN=MIN0(IY1,IY2,IYMIN)
      IYMAX=MAX0(IY1,IY2,IYMAX)
      QUAD=QUAD+PIDV2
      IF(NQUAD.LT.4)GO TO 200
C * COMPUTE SCREEN AND VIRTUAL RANGES
300   TSRANX=KMAXSX-KMINSX
      TSRANY=KMAXSY-KMINSY
      XRANGE=IXMAX-IXMIN
      YRANGE=IYMAX-IYMIN
C * COMPUTE RELATIVE RADIUS SCALE FACTOR
      FACTOR=AMIN1(ABS(TSRANX)/XRANGE,ABS(TSRANY)/YRANGE)
C * COMPUTE SCREEN OFFSETS
      TRPAR3=FLOAT(KMINSX)-FACTOR*FLOAT(IXMIN)
      TRPAR4=FLOAT(KMINSY)-FACTOR*FLOAT(IYMIN)
C * COMPUTE FINAL RADIUS SCALE FACTOR
      TRFACX=TRFACX*FACTOR
C * COMPUTE ANGLE SCALE FACTOR
      TRFACY=(TRPAR2-TRPAR1)/(TMAXVY-TMINVY)
C * APPLY CORRECT SIGN TO ANGLE SCALE FACTOR
      TRFACY=SIGN(1.,TSRANX*TSRANY)*TRFACY
      AANG=0.
C * APPLY CORRECTION FOR 'REVERSED' WINDOWS
      IF(ANEG.AND.TSRANY.LT.0..OR.TSRANX.LT.0..AND..NOT.ANEG)AANG=180.
C * COMPUTE ANGLE OFFSET
      TRPAR6=TMINVY-(TRPAR1+AANG)/TRFACY
      RETURN
      END
c
C
C----------SUBROUTINE--WINCOT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE WINCOT(X,Y,IX,IY)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DATA DE2RAD/0.01745/
C * CHECK FOR PERMITTED VALUE OF CONVERSION KEY
C * DEFAULT IS LINEAR,ERROR IS NONE
      DX=X-TMINVX
      DY=Y-TMINVY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C * BRANCH TO PROPER SECTION
C * LINEAR LOG POLAR USER ERROR
      GO TO(500,300,600,700,100),KEY
C       ERROR
100   IX=X
      IY=Y
      GO TO 800
C * LOG TRANSFORM
300   KEYL=TRPAR1+.001
      IF(KEYL .EQ. 2) GO TO 400
C * SETUP X LOG TRANSFORM
      DX=ALOG(X)-TRPAR2
400   IF(KEYL .EQ. 1) GO TO 500
C * SETUP Y LOG TRANSFORM
      DY=ALOG(Y)-TRPAR3
C * CONVERT LINEAR
500   IX=IFIX(DX*TRFACX+.5)+KMINSX
      IY=IFIX(DY*TRFACY+.5)+KMINSY
C * GO TO EXIT
      GO TO 800
C * POLAR TRANSFORMATION
600   A=(Y-TRPAR6)*TRFACY
      R=(X-TRPAR5)*TRFACX
      IX=R*COS(A*DE2RAD)+TRPAR3
      IY=R*SIN(A*DE2RAD)+TRPAR4
C * GO TO EXIT
      GO TO 800
C * USER TRANSFORMATION IN USE
700   CONTINUE
C      CALL USECOT(X,Y,IX,IY)
C * EXIT POINT
800   RETURN
      END
C
C----------SUBROUTINE--RESET-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RESET
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      KEYCON=1
      TRFACX=1.
      TRFACY=1.
      KBEAMX=0
      KHOMEY=3068/KFACTR
      KBEAMY=KHOMEY
      KMINSX=0
      KMAXSX=4095/KFACTR
      KMINSY=0
      KMAXSY=3120/KFACTR
      KHORSZ=56
      KLINE=0
      KZAXIS=0
      KLMRGN=0
      KRMRGN=4096/KFACTR
      KSIZEF=1
      KTBLSZ=10
      KVERSZ=88
      TMINVX=0.
      TMAXVX=KMAXSX
      TMINVY=0.
      TMAXVY=KMAXSY
      TRCOSF=1.
      TRSINF=0.
      TRSCAL=1.
C * MOVE TO THE HOME POSITION
      CALL MOVABS(KLMRGN,KHOMEY)
C * SET 4014 ENHANCED FOR SOLID LINES
      IF(KTERM .GE. 3)CALL CWSEND
C * PLACE 4014 IN LARGE CHARACTER SIZE
      IF(KTERM .GE. 2)CALL CHRSIZ(1)
C * PLACE THE TERMINAL IN A/N MODE
      CALL ALFMOD
      RETURN
      END
c
C
C----------SUBROUTINE--CWSEND------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CWSEND
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION ICODE(2)
      DATA ICODE(1)/27/
      ICODE(2)=96+KZAXIS*8+KLINE
      CALL TOUTST(2,ICODE)
      RETURN
      END
c
C
C----------SUBROUTINE--CHRSIZ------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CHRSIZ(K)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION ICODE(2),ICHRTB(2,4)
      DATA ICHRTB(1,1),ICHRTB(2,1)/56,88/
      DATA ICHRTB(1,2),ICHRTB(2,2)/51,82/
      DATA ICHRTB(1,3),ICHRTB(2,3)/34,53/
      DATA ICHRTB(1,4),ICHRTB(2,4)/31,48/
      DATA ICODE(1)/27/
C * CHECK TERMINAL TYPE
      IF(KTERM .LE. 1)GO TO 10
      KSIZEF=K
      IF(K .LT. 1)KSIZEF=1
      IF(K .GT. 4)KSIZEF=4
      KHORSZ=ICHRTB(1,KSIZEF)
      KVERSZ=ICHRTB(2,KSIZEF)
      ICODE(2)=55+KSIZEF
      CALL TOUTST(2,ICODE)
10    RETURN
      END
c
C
C----------SUBROUTINE--ALFMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ALFMOD
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * SET ALPHA MODE OUTPUT (US)
      CALL TOUTPT(31)
      KGRAFL=0
      KKMODE=0
      IF(KBEAMY.GT.KHOMEY) KBEAMY=KHOMEY
      RETURN
      END
c
C
C----------SUBROUTINE--NEWPAG------------------------TEKTRONIX, INC.----
C
      SUBROUTINE NEWPAG
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,12/
      IF(KKMODE .NE. 0)CALL ALFMOD
C * OUTPUT (ESC) (FF) FOR NEW PAGE
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(10)
      IF(KLMRGN.EQ.0)GO TO 10
      CALL MOVABS(KLMRGN,KHOMEY)
      CALL ALFMOD
      GO TO 20
10    KBEAMX=0
      KBEAMY=KHOMEY
20    RETURN
      END
c
C
C----------SUBROUTINE--TOUTST------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TOUTST(LEN,IADE)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION IADE(1)
      LENOUT=LEN
      IF(LENOUT .GT. KACHAR)LENOUT=KACHAR
      CALL BUFFPK(LENOUT,IADE)
      RETURN
      END
c
C
C----------SUBROUTINE--TINSTR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TINSTR(NCHAR,IADE)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION INBUFF(80),IADE(1)
      DATA ISENT,IGOT,IPAD/0,0,32/
      IF(KINLFT .GT. 0)GO TO 10
C * REQUEST A NEW INPUT BUFFER
C * PUT OUT THE OUTPUT BUFFER
      CALL TSEND
      CALL ADEIN(IGOT,INBUFF)
      IF(KTERM.GE.3) CALL CWSEND
      ISENT=0
      KINLFT=IGOT
10    LEN=NCHAR
      IF(LEN .LE. 0)GO TO 50
      DO 20 I=1,LEN
      ISENT=ISENT+1
      ITMP=I
      IF(ISENT .GT. IGOT)GO TO 30
20    IADE(I)=INBUFF(ISENT)
      KINLFT=IGOT-ISENT
      GO TO 50
C * PAD WITH BLANKS WHEN NEEDED
30    DO 40 I=ITMP,LEN
40    IADE(I)=IPAD
      KINLFT=0
50    RETURN
      END
c
C
C----------SUBROUTINE--IOWAIT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE IOWAIT(ITIME)
C * THIS ROUTINE IS USED TO GENERATE DELAYS FOR REMOTE TERMINALS
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      IF(KBAUDR.LE.0)GO TO 20
      KOUNT=ITIME*(KBAUDR/10)
      DO 10 J=1,KOUNT
C * OUTPUT (SYN) TO INSURE AGAINST LOSS OF OUTPUT WHILE
C * TERMINAL IS BUSY. (SYN) DOES NOT AFFECT THE TERMINAL.
10    CALL TOUTPT(22)
20    RETURN
      END
c
C
C----------SUBROUTINE--VECMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE VECMOD
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      IF(KKMODE.EQ.1)GO TO 10
C * OUTPUT (US) TO ENTER A/N MODE AND RESET FOR VECTOR MODE
      CALL TOUTPT(31)
      DO 112 II=1,5
112   KPCHAR(II)=-1
      KKMODE=1
C * OUTPUT (GS) TO ENTER VECTOR MODE
10    CALL TOUTPT(29)
      KMOVEF=1
      RETURN
      END
c
C
C----------SUBROUTINE--XYCNVT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE XYCNVT(IX,IY)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION IPLT(5),IOPT(8)
      DATA IDREW /0/
C * RECEIVE THE PLOT CHARACTERS
      IX1=MIN0(4095/KFACTR,MAX0(0,IX))
      IY1=MIN0(4095/KFACTR,MAX0(0,IY))
      CALL PLTCHR(IX1,IY1,IPLT)
C * OPTIMIZE THE OUTPUT
      LEN=0
C * CHECK IF HIGH Y IS NEEDED
      IF(KPCHAR(1) .EQ. IPLT(1))GO TO 10
C * INCLUDE HIGH Y IF NEEDED
      LEN=1
      KPCHAR(1)=IPLT(1)
      IOPT(1)=IPLT(1)
C * CHECK IF LSBYX IS NEEDED
10    IF(KTERM .LE. 2)GO TO 20
      IF(KPCHAR(2) .EQ. IPLT(2))GO TO 20
C * INCLUDE LSBYX IF NEEDED
      LEN=LEN+1
      KPCHAR(2)=IPLT(2)
      IOPT(LEN)=IPLT(2)
      GO TO 30
C * CHECK IF LOW Y IS NEEDED
20    IF(KPCHAR(3) .NE. IPLT(3))GO TO 30
      IF(KPCHAR(4) .EQ. IPLT(4))GO TO 40
C * INCLUDE LOW Y IF NEEDED
30    LEN=LEN+1
      KPCHAR(3)=IPLT(3)
      IOPT(LEN)=IPLT(3)
C * CHECK IF HIGH X IS NEEDED
      IF(KPCHAR(4) .EQ. IPLT(4))GO TO 50
C * INCLUDE HIGH X IF NEEDED
      LEN=LEN+1
      KPCHAR(4)=IPLT(4)
      IOPT(LEN)=IPLT(4)
C * CHECK IF LOW X IS NEEDED
40    IF(KPCHAR(5) .NE. IPLT(5))GO TO 50
C * CHECK IF ALL THE CHARACTERS ARE THE SAME
      IF(LEN .NE. 0)GO TO 50
C * CHECK IF (GS) FOR DARK VECTOR ALREADY SENT
      IF(KMOVEF .EQ. 1)GO TO 50
C * CHECK IF VECTOR IS ALREADY DRAWN TO SPOT
      IF(IDREW .EQ. 1)GO TO 80
C * INCLUDE THE LOW X
50    LEN=LEN+1
      KPCHAR(5)=IPLT(5)
      IOPT(LEN)=IPLT(5)
C * SEND THE ARRAY TO THE OUTPUT BUFFER
70    CALL TOUTST(LEN,IOPT)
C * SET THE COMMON AND HISTORY VARIABLES
C * SET THE DREW HERE FLAG
      IDREW=1
C * REMOVE  THE DREW HERE FLAG IF DIDNT DRAW
      IF(KMOVEF .EQ. 1)IDREW=0
C * REMOVE THE MOVE FLAG
      KMOVEF=0
80    KBEAMX=IX1
      KBEAMY=IY1
      RETURN
      END
c
C
C----------SUBROUTINE--TOUTPT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TOUTPT(KKOUT)
      DIMENSION KOUT(1)
      KOUT(1)=KKOUT
      CALL TOUTST(1,KOUT)
      RETURN
      END
c
C
C----------SUBROUTINE--PLTCHR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PLTCHR(IX,IY,ICHAR)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION ICHAR(5)
C * CALCULATE THE PLOT CHARACTERS TO ARRIVE AT IX,IY
C * ORDER IS HIY, LSBYX, LOY, HIX, LOX
      KX=IX*KFACTR
      KY=IY*KFACTR
      ICHAR(1)=MOD(KY/128,32)+32
      ICHAR(2)=MOD(KY,4)*4+MOD(KX,4)+96
      ICHAR(3)=MOD(KY/4,32)+96
      ICHAR(4)=MOD(KX/128,32)+32
      ICHAR(5)=MOD(KX/4,32)+64
      IF(KBAUDR .LT. 480) GO TO 11
      ITEMP=KPAD2-1
      IF(KTERM .LT. 2) GO TO 10
      ITEMP=IABS(KBEAMX-IX)+IABS(KBEAMY-IY)
      ITEMP=ITEMP*KPAD2*KFACTR/8192 + 1
10    KPADV=ITEMP
11    CONTINUE
      RETURN
      END
c
C
C----------SUBROUTINE--BUFFPK------------------------TEKTRONIX, INC.----
C
      SUBROUTINE BUFFPK(NCHAR,IOUT)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      DIMENSION IDATA(80),IOUT(1),ISYNC(5)
      DATA MAXLEN,LENOUT,NODATA/80,0,1/
      DATA ITEMP/0/,ISYNC(1),ISYNC(2),ISYNC(3),ISYNC(4),ISYNC(5)/5*22/
      ITRAIL=KTRAIL
      LEN=NCHAR
      KOTLFT=MAXLEN-LENOUT-KTRAIL
C * DUMP THE BUFFER IF THE MODE IS UNBUFFERED
      IF(KUNIT .EQ. 4)GO TO 45
C * DUMP THE BUFFER WHEN REQUESTED BY LEN=0
      IF(NCHAR .LE. 0)GO TO 10
C * DON'T DUMP THE BUFFER IF NEW STRING WILL FIT
      KSYNCS=KPADV
      ISETBK=0
      NCH=NCHAR-1
      IF(IOUT(1) .GT. 31) ISETBK=MIN0(ITEMP,NCH)
      IMAXL=KSYNCS+NCHAR-ISETBK
      IF(IMAXL .LE. KOTLFT)GO TO 70
C * DETERMINE IF THERE IS DATA IN BUFFER
10    IF(NODATA .EQ. 1)GO TO 50
      NODATA=1
C * DETERMINE THE FORMAT THE USER WANTS BUFFER DUMPED IN
      GO TO (20,30,40,45),KUNIT
C * OUTPUT BUFFER FORMAT IS (GS),PLTCHRS,DATA,(US)
20    LENOUT=LENOUT+1
C * APPEND (US) TO END OF BUFFER
      IDATA(LENOUT)=31
      CALL ADEOUT(LENOUT,IDATA)
C * RESTORE THE BEAM POSITION AT FIRST OF THE NEXT BUFFER
      ISUB=1
      IF(KTERM .GE. 3) ISUB=2
      CALL PLTCHR(KBEAMX,KBEAMY,IDATA(ISUB))
      IDATA(2)=IDATA(ISUB)
      LENOUT=5+ISUB
      IDATA(1)=29
C * AND NOW THE MODE BEFORE THE OUTPUT WAS ASKED FOR
      DO 19 I=2,KPAD2
      IDATA(LENOUT)=22
19    LENOUT=LENOUT+1
      KEY=KKMODE+1
      IF(KEY .LT. 1)KEY=1
      IF(KEY .GT. 5)KEY=1
C * MODE IS A/N,VEC,PNT,INC,DSH
      GO TO (21, 22, 23, 24, 22),KEY
C * ENTER A/N MODE
21    IDATA(LENOUT)=31
      GO TO 50
C * IF READY FOR A MOVE, THEN REMOVE FIXUP CHARS
22    IF(KMOVEF .EQ. 1) LENOUT=2
      LENOUT=LENOUT-1
C * CHECK IF DASHED LINE OR Z AXIS MUST BE RESTORED
      IF(KLINE .EQ. 0 .AND. KZAXIS .EQ. 0) GO TO 50
      IDATA(LENOUT+1)=27
      LENOUT=LENOUT+2
      IDATA(LENOUT)=96+KZAXIS*8+KLINE
      GO TO 50
C * ENTER POINT MODE
23    IF(KTERM .LT. 3)GO TO 22
      IDATA(LENOUT)=28
      LENOUT=LENOUT+1
      GO TO 22
C * ENTER INCREMENTAL PLOT MODE
24    IDATA(LENOUT)=30
C * RAISE OR LOWER PEN AS NEEDED
C * THE FOLLOWING 3 LINES ARE NOT NEEDED ON SOME PLOTTERS **************
      LENOUT=LENOUT+1
      IDATA(LENOUT)=80
      IF(KMOVEF .EQ. 1)IDATA(LENOUT)=32
C **********************************************************************
      GO TO 50
C * OUTPUT BUFFER FORMAT IS (SYN),DATA,(ESC)
30    IF(NCHAR .LE. 0 .AND. KGNMOD .NE. 1)GO TO 20
      LENOUT=LENOUT+1
C * APPEND (ESC) TO END OF BUFFER
      IDATA(LENOUT)=27
      CALL ADEOUT(LENOUT,IDATA)
      IDATA(1)=22
      LENOUT=1
      GO TO 50
C * OUTPUT BUFFER FORMAT IS DATA ONLY
40    CALL ADEOUT(LENOUT,IDATA)
      LENOUT=0
      GO TO 50
C * NON-BUFFERED OUTPUT FORMAT
45    IF(LENOUT .GT. 0)CALL ADEOUT(LENOUT,IDATA)
      IF(LEN .GT. 0)CALL ADEOUT(LEN,IOUT)
      IF(KPADV .GT. 0)CALL ADEOUT(KPADV,ISYNC)
      KPADV=0
      LENOUT=0
      NODATA=1
      GO TO 90
50    KOTLFT=MAXLEN-LENOUT-ITRAIL
      ITEMP=0
      ISETBK=0
      KPADV=0
      IF(LEN .LE. 0) GO TO 90
70    NODATA=0
      LENOUT=LENOUT-ISETBK
      KOTLFT=KOTLFT+ISETBK
      IF(LEN .GT. KOTLFT)LEN=KOTLFT
      DO 80 I=1,LEN
      LENOUT=LENOUT+1
80    IDATA(LENOUT)=IOUT(I)
      ITEMP=KSYNCS
      KPADV=0
      IF(ITEMP .LE. 0) GO TO 90
      DO 85 I=1,ITEMP
      LENOUT=LENOUT+1
85    IDATA(LENOUT)=22
90    KOTLFT=MAXLEN-LENOUT-ITRAIL
      RETURN
      END
c
C
C----------SUBROUTINE--RESCAL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RESCAL
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * FLAG THE OLD VIRTUAL COORDINATES AS INCORRECT
      KGRAFL=0
      KGNFLG=0
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C * BRANCH TO PROPER SECTION AND RETURN
C * LINEAR LOG POLAR USER ERROR
      GO TO (100,200,300,400,500),KEY
C * BOTH AXES LINEAR
100   TRPAR1=0.
C * SEMI LOG OR LOG LOG
200   KEYL=TRPAR1+1.001
C * X AXIS -- LINEAR OR LOG
      GO TO (210,215,210,215),KEYL
C * LINEAR
210   TRFACX=FLOAT(KMAXSX-KMINSX)/(TMAXVX-TMINVX)
      GO TO 250
C * PREVENT INVALID TRANSFORMATION
215   IF(TMINVX .GT. 0.0 .AND. TMAXVX .GT. 0.0)GO TO 220
      KGNFLG=1
      TRPAR1=TRPAR1-1.0
      GO TO 210
C * SEMI LOG X AXIS
220   TRPAR2=ALOG(TMINVX)
      TRFACX=FLOAT(KMAXSX-KMINSX)/(ALOG(TMAXVX)-TRPAR2)
C * Y AXIS -- LINEAR OR LOG
250   GO TO (260,260,270,270),KEYL
C * LINEAR
260   TRFACY=FLOAT(KMAXSY-KMINSY)/(TMAXVY-TMINVY)
      GO TO 600
C * PREVENT INVALID TRANSFORMATION
270   IF(TMINVY .GT. 0.0 .AND. TMAXVY .GT. 0.0)GO TO 280
      KGNFLG=1
      TRPAR1=TRPAR1-2.0
      GO TO 260
C * SEMI LOG Y AXIS
280   TRPAR3=ALOG(TMINVY)
      TRFACY=FLOAT(KMAXSY-KMINSY)/(ALOG(TMAXVY)-TRPAR3)
      GO TO 600
C * POLAR SCALING
300   CALL PSCAL
      GO TO 600
C * USER FUNCTION
400   CONTINUE
C      CALL URSCAL
      GO TO 600
C * NO SCALE
500   TRFACX=1.
      TRFACY=1.
600   RETURN
      END
c
C
C----------SUBROUTINE--LVLCHT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE LVLCHT
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      IF(KGRAFL.NE.0)GO TO 10
      CALL REVCOT(KBEAMX,KBEAMY,TREALX,TREALY)
      TIMAGX=TREALX
      TIMAGY=TREALY
      KGRAFL=1
10    RETURN
      END
c
C
C----------SUBROUTINE--V2ST--------------------------TEKTRONIX, INC.----
C
      SUBROUTINE V2ST(I,X,Y,IX,IY)
      DIMENSION BUFIN(4),BFOUT(4)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      EQUIVALENCE (BUFIN(1),XS),(BUFIN(2),YS),(BUFIN(3),XE),
     1(BUFIN(4),YE)
      EQUIVALENCE (BFOUT(1),CXS),(BFOUT(2),CYS),(BFOUT(3),CXE),
     1            (BFOUT(4),CYE)
      XE=X
      YE=Y
C * POINT OR MOVE
      IF(I .EQ. 0) GO TO 10
C * BRIGHT VECTOR
      XS=TIMAGX
      YS=TIMAGY
C * CLIP VECTOR
      CALL CLIPT(BUFIN,BFOUT)
C * ON SCREEN
      IF(KGNFLG .EQ. 1) GO TO 110
C * ARE WE AT START POINT
      IF(CXS .EQ. TREALX .AND. CYS .EQ. TREALY) GO TO 120
C * MOVE BEAM TO START POINT
      MODE=KKMODE
      CALL VECMOD
      CALL WINCOT(CXS,CYS,IX,IY)
      CALL XYCNVT(IX,IY)
      KKMODE=MODE
      GO TO 120
C * POINT OR MOVE
10    CALL PCLIPT(XE,YE)
C * OFF SCREEN
      IF(KGNFLG .EQ. 1) GO TO 110
      CXE=XE
      CYE=YE
C * CONVERT TO SCREEN COORDINATES
120   CALL WINCOT(CXE,CYE,IX,IY)
C * SAVE POSITION  ABS AND IMAGINARY
      TREALX=CXE
      TREALY=CYE
110   TIMAGX=X
      TIMAGY=Y
      RETURN
      END
c
C
C----------SUBROUTINE--PNTMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PNTMOD
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * CANCEL PREVIOUS MODES - OUTPUT (US)
      CALL TOUTPT(31)
      DO 111 II=1,5
111   KPCHAR(II)=-1
      KKMODE=2
C * FOR HARDWARE POINT PLOT OUTPUT AN (FS)
      IF(KTERM .GE. 3)CALL TOUTPT(28)
      RETURN
      END
c
C
C----------SUBROUTINE--TKPNT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TKPNT(IX,IY)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * THIS SECTION IS FOR 4014 ENHANCED **********************************
C      IF(KTERM .GE. 3)GO TO 10
C **********************************************************************
C * PUT OUT A GS FOR SIMULATED POINT PLOT MODE
      CALL TOUTPT(29)
      KMOVEF=1
C * MOVE TO POINT
      CALL XYCNVT(IX,IY)
C * DRAW  POINT
10    CALL XYCNVT(IX,IY)
      RETURN
      END
c
C
C----------SUBROUTINE--CLIPT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CLIPT(BUFIN,OUTBF)
      DIMENSION  BUFIN(4),OUTBF(4)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      GSTAX=BUFIN(1)
      GSTAY=BUFIN(2)
      GENDX=BUFIN(3)
      GENDY=BUFIN(4)
      IF(GSTAX.GE.TMINVX)GO TO 10
      IF(GENDX.GE.TMINVX)GO TO 20
      GO TO 110
10    IF(GSTAX.LE.TMAXVX)GO TO 20
      IF(GENDX.LE.TMAXVX)GO TO 20
      GO TO 110
20    IF(GSTAY.GE.TMINVY)GO TO 21
      IF(GENDY.GE.TMINVY)GO TO 30
      GO TO 110
21    IF(GSTAY.LE.TMAXVY)GO TO 30
      IF(GENDY.LE.TMAXVY)GO TO 30
      GO TO 110
30    IF(GSTAX.NE.GENDX)GO TO 31
      DSTAX=GSTAX
      DENDX=GSTAX
      CALL PARCLT(GSTAY,GENDY,TMINVY,TMAXVY,DSTAY,DENDY)
      GO TO 120
31    IF(GSTAY.NE.GENDY)GO TO 40
      DSTAY=GSTAY
      DENDY=GSTAY
      CALL PARCLT(GSTAX,GENDX,TMINVX,TMAXVX,DSTAX,DENDX)
      GO TO 120
40    A=GENDX-GSTAX
      B=GENDY-GSTAY
      IF(GSTAX.LT.TMINVX)GO TO 41
      IF(GSTAX.LE.TMAXVX)GO TO 43
      Q=TMAXVX
      GO TO 42
43    IF(GSTAY.GT.TMAXVY)GO TO 140
      IF(GSTAY.LT.TMINVY)GO TO 44
      DSTAX=GSTAX
      DSTAY=GSTAY
      GO TO 150
41    Q=TMINVX
42    DSTAY=GSTAY+((Q-GSTAX)*B/A)
      IF(DSTAY.GT.TMAXVY)GO TO 140
      IF(DSTAY.LT.TMINVY)GO TO 44
      DSTAX=Q
      GO TO 150
44    R=TMINVY
      GO TO 45
140   R=TMAXVY
45    DSTAX=GSTAX+((R-GSTAY)*A/B)
      IF(DSTAX.GT.TMAXVX)GO TO 110
      IF(DSTAX.LT.TMINVX)GO TO 110
      DSTAY=R
150   IF(GENDX.LT.TMINVX)GO TO 50
      IF(GENDX.GT.TMAXVX)GO TO 51
      IF(GENDY.GT.TMAXVY)GO TO 160
      IF(GENDY.LT.TMINVY)GO TO 52
      DENDX=GENDX
      DENDY=GENDY
      GO TO 120
51    Q=TMAXVX
      GO TO 53
50    Q=TMINVX
53    DENDY=GSTAY+((Q-GSTAX)*B/A)
      IF(DENDY.GT.TMAXVY)GO TO 160
      IF(DENDY.LT.TMINVY)GO TO 52
      DENDX=Q
      GO TO 120
52    R=TMINVY
      GO TO 60
160   R=TMAXVY
60    DENDX=GSTAX+((R-GSTAY)*A/B)
      DENDY=R
120   OUTBF(1)=DSTAX
      OUTBF(2)=DSTAY
      OUTBF(3)=DENDX
      OUTBF(4)=DENDY
      KGNFLG=0
      GO TO 70
C * SET FLAG IF LINE OUTSIDE WINDOW
110   KGNFLG=1
70    RETURN
      END
c
C
C----------SUBROUTINE--PCLIPT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PCLIPT(X,Y)
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
      KGNFLG=0
      IF(X.LT.TMINVX)GO TO 10
      IF(X.GT.TMAXVX)GO TO 10
      IF(Y.LT.TMINVY)GO TO 10
      IF(Y.LE.TMAXVY)GO TO 20
10    KGNFLG=1
20    RETURN
      END
c
C
C----------SUBROUTINE--PARCLT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PARCLT(RL1,RL2,RM1,RM2,RN1,RN2)
      IF(RL1.LT.RM1)GO TO 10
      IF(RL1.GT.RM2)GO TO 20
      RN1=RL1
      IF(RL2-RM1)30,40,40
10    RN1=RM1
40    IF(RL2.LE.RM2)GO TO 50
      RN2=RM2
      GO TO 60
50    RN2=RL2
      GO TO 60
20    RN1=RM2
      IF(RL2.GE.RM1)GO TO 50
30    RN2=RM1
60    RETURN
      END
c
C
C----------SUBROUTINE--TSEND-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TSEND
      DIMENSION ITEMP(1)
      CALL BUFFPK(0,ITEMP)
      RETURN
      END
c
C
C----------SUBROUTINE--RECOVR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RECOVR
      COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
     & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
     & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
     & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
     & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
     & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
     & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
     & KINLFT,KOTLFT,KUNIT
C * SAVE THE GRAPHIC LEVEL FLAG
      IFLAG=KGRAFL
C * REMOVE MOVE FLAG
      KMOVEF=0
C * SAVE THE MODE
      MODE=KKMODE+1
C * SAVE THE Y-COORDINATE
      IY=KBEAMY
C * CLEAR ALL OTHER MODES
      CALL ALFMOD
C * MOVE TO SCREEN LOCATION
      CALL MOVABS(KBEAMX,IY)
C * SET THE HARDWARE DASH AND Z-AXIS WHEN NEEDED
      IF(KTERM .GE. 2)CALL CWSEND
C * PLACE IN THE PROPER MODE
      IF(MODE .LT. 1)MODE=1
      IF(MODE .GT.5)MODE=5
      GO TO (100,200,120,100,200),MODE
100   CALL ALFMOD
      GO TO 200
120   CALL PNTMOD
C * RESTORE THE GRAPHIC LEVEL FLAG
200   KGRAFL=IFLAG
      RETURN
      END
c
C
      SUBROUTINE ADEIN(NCHAR,IARAY)
      DIMENSION IARAY(1),KARAY(72)
C
C     860527;rb
C     lab of phys chem
C
      READ 5, KARAY
    5 FORMAT(72A1)
      DO 10 K=1,72
        IF (KARAY(73-K).NE.' ') GO TO 20
   10    CONTINUE
      NCHAR=0
      RETURN
   20 NCHAR=73-K
      DO 30 I=1,NCHAR
        IARAY(I)=IAND(KARAY(I),127)
   30   CONTINUE
      RETURN
      END
C
      SUBROUTINE ADEOUT(NCHAR,IARAY)
C
C     860427;rb
C     lab of physical chemistry
C
      DIMENSION IARAY(1)
      BYTE      KARAY(80)
C
C     check for NCHAR = 0
      IF (NCHAR.EQ.0) RETURN
C     check for NCHAR > 80
      IF (NCHAR.GT.80) THEN
        PRINT *,(' TCS OVERFLOW'),NCHAR
        STOP
        ENDIF
      DO 50 I=1,NCHAR
      KARAY(I)=IAND(IARAY(I),127)
   50 CONTINUE
      CALL SEND (NCHAR,KARAY)
      RETURN
      END
C
c......... VAX/VMS specific
c
	SUBROUTINE SEND(NCHARS,ARRAY)
C
C       AJC 2/27/84
C	RB  12/23/87
C
	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'
	INCLUDE '($TTDEF)'
C
	BYTE ARRAY(1)
C
	INTEGER*4 SYS$QIOW,ICHAN
	INTEGER*2 IOSB(4)
C
	COMMON /IOINFO/ ICHAN
C
	IFUNC = IO$_WRITEVBLK + IO$M_NOFORMAT
C
	IRETURN = SYS$QIOW(,%VAL(ICHAN),%VAL(IFUNC),,,,
	1	ARRAY,%VAL(NCHARS),,,,)
C
	IF (IRETURN.NE.1)  CALL ERRMSG(IRETURN)
	RETURN
	END
c
      SUBROUTINE CHANNEL
      INTEGER*4 SYS$ASSIGN,ICHAN
      COMMON /IOINFO/ ICHAN
      LOGICAL LFLAG
      DATA LFLAG/.TRUE./
      IF (LFLAG) THEN
        IRETURN = SYS$ASSIGN('TT:',ICHAN,,)
        LFLAG=.FALSE.
        ENDIF
      RETURN
      END
c