C plautdev.f
       SUBROUTINE SQUARE(X,Y,SIDE,THETA)
       INCLUDE 'plautcom.f'
       CALL MOVEA(X,Y)
       CALL RROTAT(THETA)
       CALL DRAWR(0.,SIDE)
       CALL DRAWR(SIDE,0.)
       CALL DRAWR(0.,-SIDE)
       CALL DRAWR(-SIDE,0.)
       CALL RROTAT(-THETA)
       CALL ANMODE
       RETURN
       END
C
      SUBROUTINE ANMODE
      INCLUDE 'plautcom.f'
      CALL ALFMOD
      CALL TSEND
      RETURN
       END
C
      SUBROUTINE SEEMRG(MLEFT,MRIGHT)
      INCLUDE 'plautcom.f'
      MLEFT=KLMRGN
      MRIGHT=KRMRGN
      RETURN
      END
C
      SUBROUTINE SEETRM(IBAUDR,ITERM,ICSIZE,MAXSCR)
      INCLUDE 'plautcom.f'
      IBAUDR=KBAUDR
      ITERM=KTERM
      ICSIZE=KSIZEF
      MAXSCR=4096/KFACTR
      RETURN
      END
C
      SUBROUTINE SEETW(MINX,MAXX,MINY,MAXY)
      INCLUDE 'plautcom.f'
      MINX=KMINSX
      MAXX=KMAXSX
      MINY=KMINSY
      MAXY=KMAXSY
      RETURN
      END
C
      SUBROUTINE SEEDW(XMIN,XMAX,YMIN,YMAX)
      INCLUDE 'plautcom.f'
      XMIN=TMINVX
      XMAX=TMAXVX
      YMIN=TMINVY
      YMAX=TMAXVY
      RETURN
      END
C
      SUBROUTINE SEEMOD(LINE,IZAXIS,MODE)
      INCLUDE 'plautcom.f'
      LINE=KLINE
      IZAXIS=KZAXIS
      MODE=KKMODE
      RETURN
      END
C
      SUBROUTINE SEETRN(XFAC,YFAC,KEY)
      INCLUDE 'plautcom.f'
      XFAC=TRFACX
      YFAC=TRFACY
      KEY=KEYCON
      RETURN
      END
C
      SUBROUTINE SEEREL(RCOS,RSIN,SCALE)
      INCLUDE 'plautcom.f'
      RCOS=TRCOSF
      RSIN=TRSINF
      SCALE=TRSCAL
      RETURN
      END
C
      SUBROUTINE TTBLSZ(ITBLSZ)
      INCLUDE 'plautcom.f'
      KTBLSZ=ITBLSZ
      RETURN
      END
C
      SUBROUTINE TERM(ITERM,ISCAL)
      INCLUDE 'plautcom.f'
      KTERM=ITERM
      KFACTR=4
      IF(ISCAL .GT. 1025)KFACTR=1
      CALL RESET
      RETURN
      END
C
      SUBROUTINE DASHSR(X,Y,L)
      INCLUDE 'plautcom.f'
      CALL REL2AB(X,Y,RX,RY)
      CALL DASHSA(RX,RY,L)
      RETURN
      END
C
      SUBROUTINE DASHSA(X,Y,L)
      INCLUDE 'plautcom.f'
      CALL LVLCHT
      XOLD=TIMAGX
      YOLD=TIMAGY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
      GO TO (100, 100, 200, 400, 100),KEY
100   CALL DASHA(X,Y,L)
      XOLD=X
      YOLD=Y
      RETURN
200   DX=X-XOLD
      DY=Y-YOLD
      YSTEP=SIGN(5.0/TRFACY,DY)
      IF(ABS(DY*.75) .LT. ABS(YSTEP)) GO TO 100
      FRAC=DX/DY
      NSEG=INT((DY/YSTEP)+.9999)
      YOUT=YOLD
300   IF(NSEG .LT. 2) GO TO 100
      YOUT=YOUT+YSTEP
      XOUT=XOLD+(YOUT-YOLD)*FRAC
      CALL DASHA(XOUT,YOUT,L)
      NSEG=NSEG-1
      GO TO 300
400   CONTINUE
      GO TO 100
      END
C
      SUBROUTINE DRAWSR(X,Y)
      INCLUDE 'plautcom.f'
      CALL REL2AB(X,Y,RX,RY)
      CALL DRAWSA(RX,RY)
      RETURN
      END
C
      SUBROUTINE DRAWSA(X,Y)
      INCLUDE 'plautcom.f'
      CALL LVLCHT
      XOLD=TIMAGX
      YOLD=TIMAGY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
      GO TO (100, 100, 200, 400, 100),KEY
100   CALL DRAWA(X,Y)
      XOLD=X
      YOLD=Y
      RETURN
200   DX=X-XOLD
      DY=Y-YOLD
      YSTEP=SIGN(5.0/TRFACY,DY)
      IF(ABS(DY*.75) .LT. ABS(YSTEP)) GO TO 100
      FRAC=DX/DY
      NSEG=INT((DY/YSTEP)+.9999)
      YOUT=YOLD
300   IF(NSEG .LT. 2) GO TO 100
      YOUT=YOUT+YSTEP
      XOUT=XOLD+(YOUT-YOLD)*FRAC
      CALL DRAWA(XOUT,YOUT)
      NSEG=NSEG-1
      GO TO 300
400   CONTINUE
      GO TO 100
      END
C
      SUBROUTINE INCPLT(IONOFF,IDIR,NO)
      INCLUDE 'plautcom.f'
      DIMENSION IPLTBL(8),KBMUP(10)
      DATA IPLTBL(1),IPLTBL(2),IPLTBL(3),IPLTBL(4)/4,5,1,9/
      DATA IPLTBL(5),IPLTBL(6),IPLTBL(7),IPLTBL(8)/8,10,2,6/
      DATA KBMUP(1),KBMUP(2),KBMUP(3),KBMUP(4)/0,1,1,1/
      DATA KBMUP(5),KBMUP(6),KBMUP(7),KBMUP(8)/0,-1,-1,-1/
      DATA KBMUP(9),KBMUP(10)/0,1/
      IF(KKMODE .NE. 3)CALL IPMOD
      IPEN=32+IONOFF*48
      CALL TOUTPT(IPEN)
      IPEN=64
      KMOVEF=IABS(IONOFF-1)
      NDXPLT=MOD(IDIR,8)+1
      IPLTCH=IPLTBL(NDXPLT)+IPEN
      KBMUPX=KBMUP(NDXPLT)
      KBMUPY=KBMUP(NDXPLT+2)
      DO I=1,NO
         CALL TOUTPT(IPLTCH)
         KBEAMX=KBEAMX+KBMUPX
         KBEAMY=KBEAMY+KBMUPY
      ENDDO
      RETURN
      END
C
      SUBROUTINE RROTAT(DEG)
      INCLUDE 'plautcom.f'
      TRSINF=SIN(DEG/57.29578)
      TRCOSF=COS(DEG/57.29578)
      RETURN
      END
C
      SUBROUTINE RSCALE(FACTOR)
      INCLUDE 'plautcom.f'
      TRSCAL=FACTOR
      RETURN
      END
C
      SUBROUTINE FINITT(IX,IY)
      INCLUDE 'plautcom.f'
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      CALL MOVABS(IX,IY)
      CALL ALFMOD
      CALL TSEND
      RETURN
      END
C
      SUBROUTINE BELL
      INCLUDE 'plautcom.f'
      CALL TOUTPT(7)
      KMOVEF=0
      RETURN
      END
C
      SUBROUTINE VWINDO(XMIN,XRANGE,YMIN,YRANGE)
      INCLUDE 'plautcom.f'
      TMINVX=XMIN
      TMAXVX=XMIN+XRANGE
      TMINVY=YMIN
      TMAXVY=YMIN+YRANGE
      CALL RESCAL
      RETURN
      END
C
      SUBROUTINE SWINDO(MINX,LENX,MINY,LENY)
      INCLUDE 'plautcom.f'
      KMINSX=MINX
      KMAXSX=MINX+LENX
      KMINSY=MINY
      KMAXSY=MINY+LENY
      CALL RESCAL
      RETURN
      END
C
      SUBROUTINE TWINDO(MINX,MAXX,MINY,MAXY)
      INCLUDE 'plautcom.f'
      KMINSX=MINX
      KMAXSX=MAXX
      KMINSY=MINY
      KMAXSY=MAXY
      CALL RESCAL
      RETURN
      END
C
      SUBROUTINE DWINDO(XMIN,XMAX,YMIN,YMAX)
      INCLUDE 'plautcom.f'
      TMINVX=XMIN
      TMAXVX=XMAX
      TMINVY=YMIN
      TMAXVY=YMAX
      CALL RESCAL
      RETURN
      END
C
      SUBROUTINE LWINDO(XMIN,XMAX,YMIN,YMAX,KEY)
      INCLUDE 'plautcom.f'
      CALL DWINDO(XMIN,XMAX,YMIN,YMAX)
      IF(KEY-3.GT.0.OR.KEY.LE.0)THEN
         CALL LINTRN
         RETURN
      ENDIF
      CALL LOGTRN(KEY)
      RETURN
      END
C
      SUBROUTINE POINTR(X,Y)
      INCLUDE 'plautcom.f'
      CALL REL2AB(X,Y,RX,RY)
      CALL POINTA(RX,RY)
      RETURN
      END
C
      SUBROUTINE DASHR(X,Y,L)
      INCLUDE 'plautcom.f'
      CALL REL2AB(X,Y,XL,YL)
      CALL DASHA(XL,YL,L)
      RETURN
      END
C
      SUBROUTINE DASHA(X,Y,L)
      INCLUDE 'plautcom.f'
      CALL LVLCHT
      CALL V2ST(1,X,Y,IX,IY)
      IF(KGNFLG .EQ. 1)GO TO 10
      CALL DSHMOD(L)
      CALL TKDASH(IX,IY)
10    RETURN
      END
C
      SUBROUTINE DSHREL(IX,IY,L)
      INCLUDE 'plautcom.f'
      JX=IX+KBEAMX
      JY=IY+KBEAMY
      CALL DSHABS(JX,JY,L)
      RETURN
      END
C
      SUBROUTINE DSHABS(IX,IY,L)
      INCLUDE 'plautcom.f'
      CALL DSHMOD(L)
      CALL TKDASH(IX,IY)
      RETURN
      END
C
      SUBROUTINE DRAWR(X,Y)
      INCLUDE 'plautcom.f'
      CALL REL2AB(X,Y,RX,RY)
      CALL DRAWA(RX,RY)
      RETURN
      END
C
      SUBROUTINE POINTA(X,Y)
      INCLUDE 'plautcom.f'
      CALL LVLCHT
      CALL V2ST(0,X,Y,IX,IY)
      IF(KGNFLG .EQ. 1)GO TO 10
      IF(KKMODE .NE. 2)CALL PNTMOD
      CALL TKPNT(IX,IY)
10    RETURN
      END
C
      SUBROUTINE DRAWA(X,Y)
      INCLUDE 'plautcom.f'
      IF(KLINE .EQ. 0)GO TO 5
      KLINE=0
      CALL CWSEND
5     CONTINUE
      CALL LVLCHT
      CALL V2ST(1,X,Y,IX,IY)
      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
      SUBROUTINE MOVER(X,Y)
      INCLUDE 'plautcom.f'
      CALL REL2AB(X,Y,RX,RY)
      CALL MOVEA(RX,RY)
      RETURN
      END
C
      SUBROUTINE REL2AB(XIN,YIN,XOUT,YOUT)
      INCLUDE 'plautcom.f'
      CALL LVLCHT
      XOUT=(((XIN*TRCOSF)-(YIN*TRSINF))*TRSCAL)+TIMAGX
      YOUT=(((XIN*TRSINF)+(YIN*TRCOSF))*TRSCAL)+TIMAGY
      RETURN
      END
C
      SUBROUTINE MOVEA(X,Y)
      INCLUDE 'plautcom.f'
      CALL LVLCHT
      CALL V2ST(0,X,Y,IX,IY)
      IF(KGNFLG .EQ. 1)GO TO 10
      CALL VECMOD
      CALL XYCNVT(IX,IY)
10    RETURN
      END
C
      SUBROUTINE VCURSR(ICHAR,X,Y)
      INCLUDE 'plautcom.f'
      CALL SCURSR(ICHAR,IXA,IYA)
      CALL REVCOT(IXA,IYA,X,Y)
      RETURN
      END
C
      SUBROUTINE V2ST(I,X,Y,IX,IY)
      INCLUDE 'plautcom.f'
      DIMENSION BUFIN(4),BFOUT(4)
      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
      IF(I .EQ. 0) GO TO 10
      XS=TIMAGX
      YS=TIMAGY
      CALL CLIPT(BUFIN,BFOUT)
      IF(KGNFLG .EQ. 1) GO TO 110
      IF(CXS .EQ. TREALX .AND. CYS .EQ. TREALY) GO TO 120
      MODE=KKMODE
      CALL VECMOD
      CALL WINCOT(CXS,CYS,IX,IY)
      CALL XYCNVT(IX,IY)
      KKMODE=MODE
      GO TO 120
10    CALL PCLIPT(XE,YE)
      IF(KGNFLG .EQ. 1) GO TO 110
      CXE=XE
      CYE=YE
120   CALL WINCOT(CXE,CYE,IX,IY)
      TREALX=CXE
      TREALY=CYE
110   TIMAGX=X
      TIMAGY=Y
      RETURN
      END
C
      SUBROUTINE CLIPT(BUFIN,OUTBF)
      INCLUDE 'plautcom.f'
      DIMENSION  BUFIN(*),OUTBF(*)
      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
110   KGNFLG=1
70    RETURN
      END
C
      SUBROUTINE PARCLT(RL1,RL2,RM1,RM2,RN1,RN2)
      INCLUDE 'plautcom.f'
      IF(RL1.LT.RM1)GO TO 10
      IF(RL1.GT.RM2)GO TO 20
      RN1=RL1
      IF(RL2-RM1.LT.0)GO TO 30
      GO TO 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
      SUBROUTINE LINTRN
      INCLUDE 'plautcom.f'
      KEYCON=1
      CALL RESCAL
      RETURN
      END
C
      SUBROUTINE LOGTRN(ITYPE)
      INCLUDE 'plautcom.f'
      KEYCON=2
      TRPAR1=ITYPE
      CALL RESCAL
      RETURN
      END
C
      SUBROUTINE POLTRN(ANGMIN,ANGMAX,RSUPRS)
      INCLUDE 'plautcom.f'
      KEYCON=3
      TRPAR1=ANGMIN
      TRPAR2=ANGMAX
      TRPAR5=RSUPRS
      CALL PSCAL
      RETURN
      END
C
      SUBROUTINE RESCAL
      INCLUDE 'plautcom.f'
      KGRAFL=0
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
      GO TO (100,200,300,400,500),KEY
100   TRPAR1=0.
200   KEYL=INT(TRPAR1+1.001)
      GO TO (210,220,210,220),KEYL
210   TRFACX=FLOAT(KMAXSX-KMINSX)/(TMAXVX-TMINVX)
      GO TO 250
220   TRPAR2=ALOG(TMINVX)
      TRFACX=FLOAT(KMAXSX-KMINSX)/(ALOG(TMAXVX)-TRPAR2)
250   GO TO (260,260,280,280),KEYL
260   TRFACY=FLOAT(KMAXSY-KMINSY)/(TMAXVY-TMINVY)
      GO TO 600
280   TRPAR3=ALOG(TMINVY)
      TRFACY=FLOAT(KMAXSY-KMINSY)/(ALOG(TMAXVY)-TRPAR3)
      GO TO 600
300   CALL PSCAL
      GO TO 600
400   CONTINUE
      GO TO 600
500   TRFACX=1.
      TRFACY=1.
600   RETURN
      END
C
      SUBROUTINE PSCAL
      INCLUDE 'plautcom.f'
      LOGICAL ANEG
      ANEG=TRPAR1 .GT. TRPAR2
      KGRAFL=0
      PIDV2=90.00
      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)
      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
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
300   TSRANX=KMAXSX-KMINSX
      TSRANY=KMAXSY-KMINSY
      XRANGE=IXMAX-IXMIN
      YRANGE=IYMAX-IYMIN
      FACTOR=AMIN1(ABS(TSRANX)/XRANGE,ABS(TSRANY)/YRANGE)
      TRPAR3=FLOAT(KMINSX)-FACTOR*FLOAT(IXMIN)
      TRPAR4=FLOAT(KMINSY)-FACTOR*FLOAT(IYMIN)
      TRFACX=TRFACX*FACTOR
      TRFACY=(TRPAR2-TRPAR1)/(TMAXVY-TMINVY)
      TRFACY=SIGN(1.,TSRANX*TSRANY)*TRFACY
      AANG=0.
      IF(ANEG.AND.TSRANY.LT.0..OR.TSRANX.LT.0..AND..NOT.ANEG)
     1 AANG=180.
      TRPAR6=TMINVY-(TRPAR1+AANG)/TRFACY
      RETURN
      END
C
      SUBROUTINE WINCOT(X,Y,IX,IY)
      INCLUDE 'plautcom.f'
      DATA DE2RAD/0.01745/
      DX=X-TMINVX
      DY=Y-TMINVY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
      GO TO(500,300,600,700,100),KEY
100   IX=INT(X)
      IY=INT(Y)
      GO TO 800
300   KEYL=INT(TRPAR1+.001)
      IF(KEYL .EQ. 2) GO TO 400
      DX=ALOG(X)-TRPAR2
400   IF(KEYL .EQ. 1) GO TO 500
      DY=ALOG(Y)-TRPAR3
500   IX=IFIX(DX*TRFACX)+KMINSX
      IY=IFIX(DY*TRFACY)+KMINSY
      GO TO 800
600   A=(Y-TRPAR6)*TRFACY
      R=(X-TRPAR5)*TRFACX
      IX=INT(R*COS(A*DE2RAD)+TRPAR3)
      IY=INT(R*SIN(A*DE2RAD)+TRPAR4)
      GO TO 800
700   CONTINUE
800   RETURN
      END
C
      SUBROUTINE LVLCHT
      INCLUDE 'plautcom.f'
      IF(KGRAFL.NE.0)GO TO 10
      CALL REVCOT(KBEAMX,KBEAMY,TREALX,TREALY)
      TIMAGX=TREALX
      TIMAGY=TREALY
      KGRAFL=1
10    RETURN
      END
C
      SUBROUTINE REVCOT(IX,IY,X,Y)
      INCLUDE 'plautcom.f'
      LOGICAL DEC
      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
      GO TO(300, 400, 500, 600, 100  ),KEY
100   X=IX
      Y=IY
      GO TO 700
300   X=DX+TMINVX
      Y=DY+TMINVY
      GO TO 700
400   KEYL=INT(TRPAR1)
      X=DX+TMINVX
      Y=DY+TMINVY
      IF(KEYL .NE. 2)X=E**(DX+TRPAR2)
      IF(KEYL .NE. 1)Y=E**(DY+TRPAR3)
      GO TO 700
500   DX=FLOAT(IX)-TRPAR3
      DY=FLOAT(IY)-TRPAR4
      Y=ATAN2(DY,DX)*57.2957795131
      X=SQRT(DY*DY+DX*DX)/TRFACX+TRPAR5
      DEC=.FALSE.
510   IF(Y .GT. TRPAR1) GO TO 530
      Y=Y+360.0
      GO TO 510
530   IF(Y .LE. TRPAR2) GO TO 550
      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))
     1 GO TO 560
      Y=AMOD(Y+180.,360.)
      X=-X
560   Y=Y/TRFACY+TRPAR6
      GO TO 700
600   CONTINUE
700   CALL PCLIPT(X,Y)
      RETURN
      END
C
      SUBROUTINE PCLIPT(X,Y)
      INCLUDE 'plautcom.f'
      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
      SUBROUTINE PNTREL(IX,IY)
      INCLUDE 'plautcom.f'
      JX=KBEAMX+IX
      JY=KBEAMY+IY
      CALL PNTABS(JX,JY)
      RETURN
      END
C
      SUBROUTINE PNTABS(IX,IY)
      INCLUDE 'plautcom.f'
      IF(KKMODE .NE. 2)CALL PNTMOD
      CALL TKPNT(IX,IY)
      KGRAFL=0
      RETURN
      END
C
      SUBROUTINE DRWREL(IX,IY)
      INCLUDE 'plautcom.f'
      JX=KBEAMX+IX
      JY=KBEAMY+IY
      CALL DRWABS(JX,JY)
      RETURN
      END
C
      SUBROUTINE DRWABS(IX,IY)
      INCLUDE 'plautcom.f'
      IF(KLINE .EQ. 0)GO TO 5
      KLINE=0
      CALL CWSEND
5     CONTINUE
      IF(KKMODE.NE.1)CALL VECMOD
      IF(KMOVEF.EQ.1)CALL XYCNVT(KBEAMX,KBEAMY)
      CALL XYCNVT(IX,IY)
      KGRAFL=0
      RETURN
      END
C
      SUBROUTINE SETMRG(MLEFT,MRIGHT)
      INCLUDE 'plautcom.f'
      KLMRGN=MLEFT
      KRMRGN=MRIGHT
      RETURN
      END
C
      SUBROUTINE MOVREL(IX,IY)
      INCLUDE 'plautcom.f'
      JX=KBEAMX+IX
      JY=KBEAMY+IY
      CALL MOVABS(JX,JY)
      RETURN
      END
C
      SUBROUTINE SETTAB(ITAB,ITBTBL)
      INCLUDE 'plautcom.f'
      DIMENSION ITBTBL(1)
      KGNFLG=0
      IF(ITAB.LE.0)GO TO 10
      I=1
20    IF(ITBTBL(I).EQ.ITAB)GO TO 10
      IF(ITAB.LT.ITBTBL(I))GO TO 60
      IF(ITBTBL(I).EQ.0)GO TO 60
      I=I+1
      IF(I.LE.KTBLSZ)GO TO 20
30    KGNFLG=1
10    RETURN
60    ITEMP=ITBTBL(I)
      ITBTBL(I)=ITAB
70    IF(ITEMP.EQ.0)GO TO 10
      I=I+1
      IF(I.GT.KTBLSZ)GO TO 30
      ITEMPA=ITBTBL(I)
      ITBTBL(I)=ITEMP
      ITEMP=ITEMPA
      GO TO 70
      END
C
      SUBROUTINE RSTTAB(ITAB,ITBTBL)
      INCLUDE 'plautcom.f'
      DIMENSION ITBTBL(1)
      IF(ITAB.LT.0)GO TO 10
      IF(ITAB.EQ.0)GO TO 20
      DO I=1,KTBLSZ
        IF(ITAB.EQ.ITBTBL(I))GO TO 50
      ENDDO
      GO TO 10
50    J=KTBLSZ-1
      DO K=I,J
        ITBTBL(K)=ITBTBL(K+1)
      ENDDO
      ITBTBL(KTBLSZ)=0
      GO TO 10
20    DO II=1,KTBLSZ
        ITBTBL(II)=0
      ENDDO
10    RETURN
      END
C
      SUBROUTINE TABHOR(ITBTBL)
      INCLUDE 'plautcom.f'
      DIMENSION ITBTBL(1)
      KFLG=0
      DO 10 K=1,KTBLSZ
      IF(ITBTBL(K).NE.0)KFLG=1
      IF(ITBTBL(K).GT.KBEAMX)GO TO 20
10    CONTINUE
      IF(KFLG.EQ.0)GO TO 30
15    CALL NEWLIN
      GO TO 30
20    IF (ITBTBL(K).GE.KRMRGN) GO TO 15
      CALL MOVABS(ITBTBL(K),KBEAMY)
      CALL ALFMOD
30    RETURN
      END
C
      SUBROUTINE TABVER(ITBTBL)
      INCLUDE 'plautcom.f'
      DIMENSION ITBTBL (1)
      DO 10 K=1,KTBLSZ
      I=KTBLSZ-K+1
      IF(ITBTBL(I) .LE. 0)GO TO 10
      IF(ITBTBL(I) .LT. KBEAMY)GO TO 30
10    CONTINUE
      GO TO 20
30    CALL MOVABS(KBEAMX,ITBTBL(I))
      CALL ALFMOD
20    RETURN
      END
C
      SUBROUTINE DSHMOD(L)
      INCLUDE 'plautcom.f'
      IF(KKMODE .EQ. 4) GO TO 10
      KKMODE=4
      CALL TOUTPT(31)
      CALL TOUTPT(29)
      KMOVEF=1
      DO I=1,5
        KPCHAR(I)=-1
      ENDDO
      CALL XYCNVT(KBEAMX,KBEAMY)
10    KDASHT=L
      RETURN
      END
C
      SUBROUTINE TKDASH(IX,IY)
      INCLUDE 'plautcom.f'
      DIMENSION DTABL(10), U(9), WORK(10),ISIMHD(4)
      DATA ISIMHD(1),ISIMHD(2),ISIMHD(3)/12,31212,32/
      DATA ISIMHD(4),IDTYPE/52,-1/
      DATA U(1),U(2),U(3),U(4),U(5)/5.,-5.,10.,-10.,25./
      DATA U(6),U(7),U(8),U(9)/-25.,50.,-50.,0./
      DATA LASTX,LASTY/-1,-1/
      IF(KDASHT .LT. 0)GO TO 320
      IF(KDASHT .GT. 4)GO TO 101
      IF(KTERM .GE. 3)GO TO 103
      IF(KDASHT .EQ. 0)GO TO 330
      KDASHT=ISIMHD(KDASHT)
101   IF(KLINE .EQ. 0)GO TO 104
      KLINE=0
      CALL CWSEND
      GO TO 104
103   IF(KLINE .EQ. KDASHT)GO TO 330
      KLINE=KDASHT
      CALL CWSEND
      GO TO 330
104   CONTINUE
      IF(KDASHT .EQ. 0)GO TO 330
      IF(KDASHT .EQ. IDTYPE)GO TO 170
      ICHAR=KDASHT
      DO NO=1,10
120     IF(ICHAR.EQ.0)GO TO 150
        I=ICHAR-((ICHAR/10)*10)
        ICHAR=ICHAR/10
        IF(I.EQ.0)GO TO 120
        WORK(NO)=U(I)
      ENDDO
      NO=11
150   NO=NO-1
      DO I=1,NO
        ISUB=NO+1-I
        DTABL(I)=WORK(ISUB)
      ENDDO
      D1=DTABL(1)
      NUM=NO-1
      DO 165 K=1,NUM
      DCUR=DTABL(K)
      IF(DCUR*DTABL(K+1).GT.0. .OR. DCUR*D1 .LT.0.)GO TO 165
      DTABL(K)=DTABL(K)-1.
      DTABL(K+1)=DTABL(K+1)-1.
165   CONTINUE
      IDTYPE=KDASHT
      I=0
      SEGLEN=0
170   IF(NO-1.LT.0)GO TO 320
      IF(NO-1.EQ.0)GO TO 330
      IF(LASTX-KBEAMX.NE.0)GO TO 200
      IF(LASTY-KBEAMY.EQ.0)GO TO 210
200   SEGLEN=0
      I=0
210   X=FLOAT(KBEAMX)
      Y=FLOAT(KBEAMY)
      DX=FLOAT(IX-KBEAMX)
      DY=FLOAT(IY-KBEAMY)
      DIAG=SQRT(DX*DX+DY*DY)
      DIST=DIAG
      IF (SEGLEN-1.5.GT.0)GO TO 230
220   I=MOD(I,NO)+1
      SEGLEN=ABS(DTABL(I))
230   IF(SEGLEN-DIST.GE.0)GO TO 270
      F=SEGLEN/DIAG
      X=X+DX*F
      Y=Y+DY*F
      IF (DTABL(I).GT.0)GO TO 260
      CALL TOUTPT(29)
      KMOVEF=1
260   CALL XYCNVT(IFIX(X),IFIX(Y))
      DIST=DIST-SEGLEN
      SEGLEN=0
      GO TO 220
270   IF(DTABL(I).GT.0)GO TO 290
      CALL TOUTPT(29)
      KMOVEF=1
290   CALL XYCNVT(IX,IY)
      LASTX=IX
      LASTY=IY
      SEGLEN=SEGLEN-DIST
      GO TO 340
320   CALL TOUTPT(29)
      KMOVEF=1
330   CALL XYCNVT(IX,IY)
      NO=1-NO
      IDTYPE=KDASHT
340   RETURN
      END
C
      SUBROUTINE HDCOPY
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,23/
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(10)
      RETURN
      END
C
      FUNCTION KIN(RI)
      INCLUDE 'plautcom.f'
      KIN=INT(RI*546.0/FLOAT(KFACTR))
      IF(KTERM .GT. 1)KIN=INT(RI*285.7/FLOAT(KFACTR))
      RETURN
      END
C
      FUNCTION KCM(RC)
      INCLUDE 'plautcom.f'
      KCM=INT(RC*215.2/FLOAT(KFACTR))
      IF(KTERM .GT. 1)KCM=INT(RC*112.48/FLOAT(KFACTR))
      RETURN
      END
C
      SUBROUTINE DCURSR(ICHAR,IX,IY)
      INCLUDE 'plautcom.f'
      CALL SCURSR(ICHAR,IX,IY)
      RETURN
      END
C
      SUBROUTINE SCURSR(ICHAR,IX,IY)
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2),IN(5)
      DATA ICODE(1),ICODE(2)/27,26/
      KMOFLG(1)=1
      CALL TOUTST(2,ICODE)
      KINLFT=0
      CALL TINSTR(5,IN)
      KMOFLG(1)=0
      CALL RECOVR
      ICHAR=IN(1)
      IX=MOD(IN(2),32)*32+MOD(IN(3),32)
      IY=MOD(IN(4),32)*32+MOD(IN(5),32)
      IX=IX*4/KFACTR
      IY=IY*4/KFACTR
      RETURN
      END
C
      SUBROUTINE SVSTAT(RARRAY)
      INCLUDE 'plautcom.f'
      DIMENSION RARRAY(60),IB(41),RB(19)
      EQUIVALENCE (IB(1),KMOFLG(1)),(RB(1),TMINVX)
      DO I=1,19
        RARRAY(I)=RB(I)
      ENDDO
      DO I=1,41
        RARRAY(I+19)=IB(I)
      ENDDO
      RETURN
      END
C
      SUBROUTINE RESTAT(RARRAY)
      INCLUDE 'plautcom.f'
      DIMENSION RARRAY(60),IB(41),RB(19)
      EQUIVALENCE (IB(1),KMOFLG(1)),(RB(1),TMINVX)
      DO I=1,19
        RB(I)=RARRAY(I)
      ENDDO
      DO I=1,41
        IB(I)=INT(RARRAY(I+19))
      ENDDO
      IF(KTERM .GT. 1)CALL CHRSIZ(KSIZEF)
      IF(KTERM .GT. 2)CALL CWSEND
      CALL RECOVR
      RETURN
      END
C
      SUBROUTINE INITT(KCPS,KREAD,KWRITE,KBUF,KBL)
      INCLUDE 'plautcom.f'
      KBAUDR = KCPS
      KPAD2 = KCPS / 22 + 1
      KMOFLG(1)=0
      KTERM=1
      KFACTR=4
      KUNIT=3
      KINLFT=0
      KOTLFT=72
      CALL IOSET(KREAD,KWRITE,KBUF,KBL)
      CALL RESET
      CALL NEWPAG
      RETURN
      END
C
      SUBROUTINE SEELOC(IX,IY)
      INCLUDE 'plautcom.f'
      IX=KBEAMX
      IY=KBEAMY
      RETURN
      END
C
      SUBROUTINE SEEBUF(KFORM)
      INCLUDE 'plautcom.f'
      KFORM=KUNIT
      RETURN
      END
C
      SUBROUTINE SETBUF(KFORM)
      INCLUDE 'plautcom.f'
      KUNIT=KFORM
      IF(KUNIT .LT. 1)KUNIT=1
      IF(KUNIT .GT. 3)KUNIT=3
      RETURN
      END
C
      FUNCTION LEFTIO(IOBUF)
      INCLUDE 'plautcom.f'
      ITEMP=KINLFT
      IF(IOBUF .EQ. 2)ITEMP = KOTLFT
      LEFTIO=ITEMP
      RETURN
      END
C
      SUBROUTINE RESET
      INCLUDE 'plautcom.f'
      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=4040/KFACTR
      KSIZEF=1
      KTBLSZ=10
      KVERSZ=88
      TMINVX=0.
      TMAXVX=4095./FLOAT(KFACTR)
      TMINVY=0.
      TMAXVY=3120./FLOAT(KFACTR)
      TRCOSF=1.
      TRSINF=0.
      TRSCAL=1.
      CALL MOVABS(KLMRGN,KHOMEY)
      IF(KTERM .GE. 3)CALL CWSEND
      IF(KTERM .GE. 2)CALL CHRSIZ(1)
      CALL ALFMOD
      RETURN
      END
C
      SUBROUTINE TKPNT(IX,IY)
      INCLUDE 'plautcom.f'
      IF(KTERM .GE. 3)GO TO 10
      CALL TOUTPT(29)
      KMOVEF=1
      CALL XYCNVT(IX,IY)
10    CALL XYCNVT(IX,IY)
      RETURN
      END
C
      LOGICAL FUNCTION GENFLG(ITEM)
      INCLUDE 'plautcom.f'
      GENFLG=KGNFLG .EQ. ITEM
      RETURN
      END
C
      SUBROUTINE NEWLIN
      INCLUDE 'plautcom.f'
      CALL CARTN
      CALL LINEF
      RETURN
      END
C
      SUBROUTINE CARTN
      INCLUDE 'plautcom.f'
      IF(KLMRGN.EQ.0)GO TO 10
      CALL MOVABS(KLMRGN,KBEAMY)
      CALL ALFMOD
      GO TO 30
10    IF(KKMODE.NE.0)CALL ALFMOD
      CALL TOUTPT(13)
      KBEAMX=0
      IF(KTERM .GE. 2)CALL CWSEND
30    RETURN
      END
C
      SUBROUTINE LINEF
      INCLUDE 'plautcom.f'
      IF(KKMODE .NE. 0)CALL ALFMOD
      CALL TOUTPT(10)
      KBEAMY=KBEAMY-(KVERSZ+KFACTR/2)/KFACTR
      IF(KBEAMY .GE. 0)GO TO 200
      KBEAMY=KHOMEY
      CALL MOVABS(KBEAMX,KBEAMY)
      CALL ALFMOD
200   IF(KTERM .GE. 2)CALL CWSEND
      RETURN
      END
C
      SUBROUTINE BAKSP
      INCLUDE 'plautcom.f'
      IF(KKMODE.EQ.0)CALL ALFMOD
      CALL TOUTPT(8)
      KBEAMX=KBEAMX-(KHORSZ+KFACTR/2)/KFACTR
      IF(KBEAMX.GE.0)GO TO 10
      KBEAMX=KBEAMX+4095/KFACTR
10    RETURN
      END
C
      SUBROUTINE HOME
      INCLUDE 'plautcom.f'
      CALL MOVABS(KLMRGN,KHOMEY)
      CALL ALFMOD
      RETURN
      END
C
      SUBROUTINE ERASE
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,12/
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(3)
      CALL RECOVR
      RETURN
      END
C
      SUBROUTINE RECOVR
      INCLUDE 'plautcom.f'
      IFLAG=KGRAFL
      KMOVEF=0
      MODE=KKMODE+1
      IY=KBEAMY
      CALL ALFMOD
      CALL MOVABS(KBEAMX,IY)
      IF(MODE .LT. 1)MODE=1
      IF(MODE .GT.5)MODE=5
      GO TO (100,200,120,200,200),MODE
100   CALL ALFMOD
      GO TO 200
120   CALL PNTMOD
200   KGRAFL=IFLAG
      RETURN
      END
C
      SUBROUTINE NEWPAG
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,12/
      IF(KKMODE .NE. 0)CALL ALFMOD
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(3)
      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
      SUBROUTINE MOVABS(IX,IY)
      INCLUDE 'plautcom.f'
      CALL VECMOD
      CALL XYCNVT(IX,IY)
      KGRAFL=0
      RETURN
      END
C
      SUBROUTINE IOWAIT(ITIME)
      INCLUDE 'plautcom.f'
      IF(KBAUDR.LE.0)GO TO 20
      KOUNT = ITIME * KBAUDR
      DO J=1,KOUNT
        CALL TOUTPT(22)
      ENDDO
20    RETURN
      END
C
      SUBROUTINE VECMOD
      INCLUDE 'plautcom.f'
      IF(KKMODE.EQ.1)GO TO 10
      CALL TOUTPT(31)
      DO II=1,5
        KPCHAR(II)=-1
      ENDDO
      KKMODE=1
10    CALL TOUTPT(29)
      KMOVEF=1
      RETURN
      END
C
      SUBROUTINE CSIZE(IHORZ,IVERT)
      INCLUDE 'plautcom.f'
      IHORZ=(KHORSZ+KFACTR/2)/KFACTR
      IVERT=(KVERSZ+KFACTR/2)/KFACTR
      RETURN
      END
C
      SUBROUTINE PNTMOD
      INCLUDE 'plautcom.f'
      CALL TOUTPT(31)
      DO II=1,5
        KPCHAR(II)=-1
      ENDDO
      KKMODE=2
      IF(KTERM .GE. 3)CALL TOUTPT(28)
      RETURN
      END
C
      SUBROUTINE IPMOD
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/31,30/
      CALL TOUTST(2,ICODE)
      KKMODE=3
      KGRAFL=0
      RETURN
      END
C
      SUBROUTINE XYCNVT(IX,IY)
      INCLUDE 'plautcom.f'
      DIMENSION IPLT(6),IOPT(6)
      DATA IDREW,ISYN /0,22/
      CALL PLTCHR(IX,IY,IPLT)
      LEN=0
      IF(KPCHAR(1) .EQ. IPLT(1))GO TO 10
      LEN=1
      KPCHAR(1)=IPLT(1)
      IOPT(1)=IPLT(1)
10    IF(KTERM .LE. 2)GO TO 20
      IF(KPCHAR(2) .EQ. IPLT(2))GO TO 20
      LEN=LEN+1
      KPCHAR(2)=IPLT(2)
      IOPT(LEN)=IPLT(2)
      GO TO 30
20    IF(KPCHAR(3) .NE. IPLT(3))GO TO 30
      IF(KPCHAR(4) .EQ. IPLT(4))GO TO 40
30    LEN=LEN+1
      KPCHAR(3)=IPLT(3)
      IOPT(LEN)=IPLT(3)
      IF(KPCHAR(4) .EQ. IPLT(4))GO TO 50
      LEN=LEN+1
      KPCHAR(4)=IPLT(4)
      IOPT(LEN)=IPLT(4)
40    IF(KPCHAR(5) .NE. IPLT(5))GO TO 50
      IF(LEN .NE. 0)GO TO 50
      IF(KMOVEF .EQ. 1)GO TO 50
      IF(IDREW .EQ. 1)GO TO 80
50    LEN=LEN+1
      KPCHAR(5)=IPLT(5)
      IOPT(LEN)=IPLT(5)
60    IF(LEN .GE. KPAD2)GO TO 70
      LEN=LEN+1
      IOPT(LEN)=ISYN
      GO TO 60
70    CALL TOUTST(LEN,IOPT)
      IDREW=1
      IF(KMOVEF .EQ. 1)IDREW=0
      KMOVEF=0
80    KBEAMX=IX
      KBEAMY=IY
      RETURN
      END
C
      FUNCTION LINWDT(NUMCHR)
      INCLUDE 'plautcom.f'
      LINWDT=(KHORSZ * NUMCHR + KFACTR/2)/KFACTR
      RETURN
      END
C
      FUNCTION LINHGT(NUMLIN)
      INCLUDE 'plautcom.f'
      LINHGT=(KVERSZ * NUMLIN + KFACTR/2)/KFACTR
      RETURN
      END
C
      SUBROUTINE CHRSIZ(K)
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2),ICHRTB(2,4)
      COMMON /TKCHRT/ ICHRTB
      DATA ICHRTB(1,1),ICHRTB(2,1)/56,88/
      DATA ICHRTB(1,2),ICHRTB(2,2)/51,83/
      DATA ICHRTB(1,3),ICHRTB(2,3)/34,53/
      DATA ICHRTB(1,4),ICHRTB(2,4)/31,48/
      DATA ICODE(1)/27/
      IF(KTERM .LE. 1)GO TO 10
      IF(K .LT. 1)K=1
      IF(K .GT. 4)K=4
      KSIZEF=K
      KHORSZ=ICHRTB(1,K)
      KVERSZ=ICHRTB(2,K)
      ICODE(2)=55+K
      CALL TOUTST(2,ICODE)
10    RETURN
      END
C
      SUBROUTINE CZAXIS(ICODE)
      INCLUDE 'plautcom.f'
      IF(KTERM .LE. 1)GO TO 10
      KZAXIS=ICODE
      CALL CWSEND
10    RETURN
      END
C
      SUBROUTINE CWSEND
      INCLUDE 'plautcom.f'
      DIMENSION ICODE(2)
      DATA ICODE(1)/27/
      ICODE(2)=96+KZAXIS*8+KLINE
      CALL TOUTST(2,ICODE)
      RETURN
      END
C
      SUBROUTINE PLTCHR(IX,IY,ICHAR)
      INCLUDE 'plautcom.f'
      DIMENSION ICHAR(*)
      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
      RETURN
      END
C
      SUBROUTINE A1IN(NCHAR,IA1)
      INCLUDE 'plautcom.f'
      DIMENSION IADE(74), IA1(1)
      CALL ALFMOD
      ISEND = MIN0(NCHAR,74)
      CALL TINSTR(ISEND,IADE)
      CALL KAS2A1(ISEND,IADE,IA1)
      RETURN
      END
C
      SUBROUTINE AINST(NCHAR,IAM)
      INCLUDE 'plautcom.f'
      DIMENSION IADE(74), IAM(1)
      CALL ALFMOD
      ISEND = MIN0(NCHAR,74)
      CALL TINSTR(ISEND,IADE)
      CALL KAS2AM(ISEND,IADE,IAM)
      RETURN
      END
C
      SUBROUTINE TINPUT(IN)
      INCLUDE 'plautcom.f'
      DIMENSION INT(1)
      CALL TINSTR(1,INT)
      IN=INT(1)
      RETURN
      END
C
      SUBROUTINE A1OUT(NCHAR,IA1)
      INCLUDE 'plautcom.f'
      DIMENSION IADE(72),IA1(1)
      ITEMP=NCHAR
      DO I=1,NCHAR,72
        ISEND=72
        IF(ITEMP .LT. 72)ISEND=ITEMP
        CALL KA12AS(ISEND,IA1(I),IADE)
        CALL ANSTR(ISEND,IADE)
        ITEMP=ITEMP-72
      ENDDO
      RETURN
      END
C
      SUBROUTINE AOUTST(NCHAR,IAM)
      INCLUDE 'plautcom.f'
      DIMENSION IADE(72)
      ITEMP = NCHAR
      DO I=1,NCHAR,72
        ISEND = MIN0(ITEMP,72)
        CALL KAM2AS(ISEND)
        CALL ANSTR(ISEND,IADE)
        ITEMP = ITEMP - 72
      ENDDO
      RETURN
      END
C
      SUBROUTINE ANSTR(NCHAR,IADE)
      INCLUDE 'plautcom.f'
      DIMENSION IADE(1)
      IPT=1
      IF(KKMODE .NE. 0)CALL ALFMOD
      IF(KBEAMX .LT. KLMRGN)GO TO 10
      IF(KBEAMX .LT. KRMRGN)GO TO 20
10    CALL NEWLIN
20    ISEND=((KRMRGN-KBEAMX)*KFACTR+KHORSZ-1)/KHORSZ
      IF(ISEND .LT. 1)ISEND=1
      IEND=IPT+ISEND-1
      IF(IEND .GT. NCHAR)ISEND=NCHAR-IPT+1
      CALL TOUTST(ISEND,IADE(IPT))
      KBEAMX=KBEAMX+(ISEND*KHORSZ+KFACTR/2)/KFACTR
      IPT=IPT+ISEND
      IF(IEND .LT. NCHAR)GO TO 10
      RETURN
      END
C
      SUBROUTINE ANCHO(ICHAR)
      INCLUDE 'plautcom.f'
      IF(KKMODE.EQ.0)GO TO 10
      CALL ALFMOD
10    CALL TOUTPT(ICHAR)
      KBEAMX=KBEAMX+(KHORSZ+KFACTR/2)/KFACTR
      IF(KBEAMX.LT.KRMRGN)GO TO 20
      CALL NEWLIN
20    RETURN
      END
C
      SUBROUTINE TOUTPT(KKOUT)
      INCLUDE 'plautcom.f'
      DIMENSION KOUT(1)
      KOUT(1)=KKOUT
      CALL TOUTST(1,KOUT)
      RETURN
      END
C
      SUBROUTINE ALFMOD
      INCLUDE 'plautcom.f'
      CALL TOUTPT(31)
      KKMODE=0
      IF(KBEAMY.GT.KHOMEY) KBEAMY=KHOMEY
      RETURN
      END
C
      SUBROUTINE TOUTST(LEN,IADE)
      INCLUDE 'plautcom.f'
      integer*2 iout(75) 
      INTEGER IADE(1), FIRST, BLOKLEN
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      DATA BLOKLEN /73/
                       
      IF((LEN.LE.0) .OR. (KWRITE.LE.0))RETURN
      FIRST = 1
      LAST = BLOKLEN
                    
20    IF(LAST.GT.LEN)LAST = LEN
      NXTOUT = 0
      DO I=FIRST,LAST
        NXTOUT = NXTOUT + 1
        IOUT(NXTOUT) = IADE(I)
      ENDDO
      WRITE(KWRITE,101)char(iout(1))
      if(nxtout.gt.1)then
        do 99 i=2,nxtout
          write(kwrite,101)char(iout(i))
 99     continue
      endif
101   FORMAT(A1,$)
            IF(LAST.GE.LEN)RETURN
      FIRST = FIRST + BLOKLEN
      LAST = LAST + BLOKLEN
      GO TO 20
      END
C
      SUBROUTINE TINSTR(NCHAR,IADE)
      INCLUDE 'plautcom.f'
      INTEGER IBUFF(75), IADE(1)
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      DATA IBLANK /32/
      IF(NCHAR.LE.0)RETURN
      IF(INMODE.EQ.0 .AND. KINLFT.GT.0)GO TO 20
      CALL ADEIN(IGOT,IBUFF)
      NXTOUT = 0
      MOVENUM = 0
      KINLFT = IGOT
      IF(KINLFT .LE. 0)GO TO 60
20    MOVENUM = NCHAR
      IF(MOVENUM .GT. KINLFT)MOVENUM = KINLFT
      DO 40 I=1,MOVENUM
      NXTOUT = NXTOUT + 1
      IADE(I) = IBUFF(NXTOUT)
40    CONTINUE
      KINLFT = IGOT - NXTOUT
      IF(MOVENUM .LT. NCHAR)GO TO 60
      IF(INMODE .EQ. 1)KINLFT = 0
      RETURN
60    KINLFT = 0
      MOVENUM = MOVENUM + 1
      DO 80 I=MOVENUM,NCHAR
      IADE(I) = IBLANK
80    CONTINUE
      RETURN
      END
C
      SUBROUTINE ADEIN(ICOUNT,IBUFF)
      INCLUDE 'plautcom.f'
      INTEGER  IPK(75), IBUFF(1)
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      ICOUNT = 0
      IF((KREAD.EQ.0) .OR. (KWRITE.EQ.0))RETURN
      READ(KREAD,101)IPK
101   FORMAT(75A1)
      DO 40 I=1,75
      IF(IPK(I) .EQ. 0)GO TO 40
      IF(IPK(I) .EQ. 15) GO TO 80
      IF(IPK(I) .NE. 10) GO TO 30
      ITEMP = MAX0(ITEMP-1,0)
      GO TO 40
30    ITEMP = ITEMP + 1
      IBUFF(ITEMP) = IPK(I)
40    CONTINUE
80    ICOUNT = MAX0(ITEMP,0)
      RETURN
      END
C
      SUBROUTINE IOSET(KIN,KOUT,KBUF,KBL)
      INCLUDE 'plautcom.f'
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      DATA KREAD, KWRITE, KSPOOL, INMODE /3*0,0/
      KREAD = KIN
      KWRITE = KOUT
      IF((KREAD.LT.0) .OR. (KREAD.GT.99)) KREAD = 0
      IF((KWRITE.LT.0) .OR. (KWRITE.GT.99)) KWRITE = 0
      RETURN
      END
C
      SUBROUTINE TSEND
      INCLUDE 'plautcom.f'
      RETURN
      END
C
      SUBROUTINE BUFMOD
      INCLUDE 'plautcom.f'
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      INMODE = 0
      RETURN
      END
C
      SUBROUTINE LINMOD
      INCLUDE 'plautcom.f'
      COMMON /TIOCOM/ KREAD, KWRITE, KSPOOL, INMODE
      INMODE = 1
      KINLFT = 0
      RETURN
      END
C
      SUBROUTINE KAS2A1(NCHAR,KADE,KA1)
      INCLUDE 'plautcom.f'
      INTEGER KA1(1), KADE(1)
      IF(NCHAR .LE. 0)RETURN
      DO I=1,NCHAR
        KA1(I) = KADE(I)
      ENDDO
      RETURN
      END
C
      SUBROUTINE KA12AS(NCHAR,KA1,KADE)
      INCLUDE 'plautcom.f'
      INTEGER KA1(1), KADE(1)
      IF(NCHAR .LE. 0)RETURN
      DO I=1,NCHAR
        KADE(I) = KA1(I)
      ENDDO
      RETURN
      END
C
      SUBROUTINE KAS2AM(NCHAR,KADE,KAM)
      INCLUDE 'plautcom.f'
      INTEGER  KADE(1), KAM(1)
      IF(NCHAR .LE. 0) RETURN
      IN = 0
      IOUT = 0
      LEFT = NCHAR
      IF(LEFT .LT. 4) GO TO 60
20    IOUT = IOUT + 1
      KAM(IOUT) = KADE(IN+1)+KADE(IN+2)*256
      KAM(IOUT) = KAM(IOUT)+KADE(IN+3)*65536+KADE(IN+4)*16777216
      IN = IN + 4
      LEFT = LEFT - 4
      IF(LEFT .GE. 4) GO TO 20
      IF(LEFT .EQ. 0) RETURN
60    IOUT = IOUT + 1
      IF(LEFT.NE.3) GO TO 61
      KAM(IOUT)=KADE(IN+1)+KADE(IN+2)*256+KADE(IN+3)*65536+32*16777216
      RETURN
61    IF(LEFT.NE.2) GO TO 62
      KAM(IOUT)=KADE(IN+1)+KADE(IN+2)*256+32*65536+32*16777216
      RETURN
62    IF(LEFT.NE.1) RETURN
      KAM(IOUT)=KADE(IN+1)+32*256+32*65536+32*16777216
      RETURN
      END
C
      SUBROUTINE KAM2AS(NCHAR)
      INCLUDE 'plautcom.f'
      IF(NCHAR .LE. 0) RETURN
      RETURN
      END
