C *** ZETA PDP-11 FORTRAN ZSUBS   RELEASE 5.36 OF 12/78
C-----------------------------------------------------------------------
C;  Copyright (C) 1995
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
      SUBROUTINE NEWPEN(IPEN)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDUM1,IPENUP,
     + IDUM2(9),IPNUM,IPRIM,IDUM3(3),OLDX,OLDY,DUM1(7),X0,DUM2(19)
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(IPEN+1)
      ICHAR=ICHAR+2
      IPNUM=IPEN
      IPENUP=3
      IF(IPRIM.EQ.0)GO TO 10
      XSAV=OLDX
      CALL SYMBOL(-X0-1.5,OLDY,.2,5HPRIME,0.,5)
      CALL PLOT(XSAV,OLDY,3)
 10   RETURN
      END
      SUBROUTINE OFFSET(XO,XF,YO,YF)
      COMMON /ZYYZ/IDUM(1149),DUM1(2),XOFF,XFACT,
     + YOFF,YFACT,DUM2(23)
      XOFF=XO
      YOFF=YO
      YFACT=YF
      XFACT=XF
      RETURN
      END
      SUBROUTINE FACTOR(FACT1)
      COMMON /ZYYZ/IDUM(1149),DUM1(7),PMSIZE,FACT,DUM2(20)
      FACT=FACT1*PMSIZE*100.
      RETURN
      END
      SUBROUTINE ZETAPS(ISW,NUMPAT,ITOTNP)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IDUM1,IOBLOK,
     + IDUM2(10),ISTORE,IPSTAT,IPLOC,OLDX,OLDY,DUM1(6),FACT,DUM2(20)
      COMMON /ZXXZ/IPA(1)
      CALL PLOT(OLDX,OLDY,3)
      IK=3*NUMPAT
      GO TO (100,100,200,300),ISW+1
 100  IPSTAT=ISW
      IPA(1)=ITOTNP*3+1
      IPA(IK-1)=OLDX*FACT+SIGN(.5,OLDX)
      IPA(IK)=OLDY*FACT+SIGN(.5,OLDY)
      IPLOC=ICHAR
      RETURN
 200  CALL ZZZZ
      IF(IPSTAT.EQ.0)GO TO 210
      IPA(IK-1)=OLDX*FACT+SIGN(.5,OLDX)-IPA(IK-1)
      IPA(IK)=OLDY*FACT+SIGN(.5,OLDY)-IPA(IK)
      GO TO 220
 210  ICHAR=IPLOC
      ITEMP=OLDX*FACT+SIGN(.5,OLDX)
      OLDX=IPA(IK-1)/FACT
      IPA(IK-1)=ITEMP-IPA(IK-1)
      ITEMP=OLDY*FACT+SIGN(.5,OLDY)
      OLDY=IPA(IK)/FACT
      IPA(IK)=ITEMP-IPA(IK)
 220  IPA(IK+1)=IPA(1)+ISTORE-1
      IPSTAT=-1
      RETURN
 300  ISTRT=IPA(IK-2)+1
      IFIN=IPA(IK+1)
 310  ITEMP=ISTRT+59
      IF(ITEMP.GT.IFIN)ITEMP=IFIN
      J=ICHAR-ISTRT
      DO 320 I=ISTRT,ITEMP
      IOBUFF(J+I)=IPA(I)
 320  CONTINUE
      ICHAR=J+ITEMP+1
      IF(ICHAR.GT.IOBLOK)CALL PLOT(OLDX,OLDY,3)
      IF(ITEMP.EQ.IFIN)GO TO 330
      ISTRT=ISTRT+60
      GO TO 310
 330  OLDX=OLDX+IPA(IK-1)/FACT
      OLDY=OLDY+IPA(IK)/FACT
      RETURN
      END
      SUBROUTINE WHERE(X,Y,FACT1)
      COMMON /ZYYZ/IDUM(1149),OLDX,OLDY,DUM1(5),
     + PMSIZE,FACT,DUM2(20)
      X=OLDX
      Y=OLDY
      FACT1=FACT/(PMSIZE*100.)
      RETURN
      END
      SUBROUTINE POFF
      CALL PLOT(0.,0.,998)
      RETURN
      END
      SUBROUTINE SPEED(IRATE)
      DIMENSION JRATE(20,2)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDUM1(10),
     + MONIT,IDUM2(5),DUM(29)
      DATA JRATE/
     + 1H0,1H0,1H0,1H0,1H0,1H0,1H0,1H0,1H0,1H0,
     + 1H0,1H1,1H1,1H1,1H1,1H1,1H2,1H2,1H3,1H4,
     + 1H0,1H1,1H2,1H3,1H5,1H7,1HC,1HF,1HJ,1HO,
     + 1HT,1H0,1H6,1HE,1HL,1HS,1H2,1HC,1H4,1H6/
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(6)
      ITEMP=IASCI(1)
      IF(MONIT.EQ.0)GO TO 10
      IOBUFF(ICHAR+2)=IASCI(IRATE+1)
      IOBUFF(ICHAR+3)=ITEMP
      IOBUFF(ICHAR+4)=ITEMP
      IOBUFF(ICHAR+5)=ITEMP
      GO TO 20
 10   IOBUFF(ICHAR+2)=ITEMP
      IOBUFF(ICHAR+3)=ITEMP
      IOBUFF(ICHAR+4)=JRATE(IRATE,1)
      IOBUFF(ICHAR+5)=JRATE(IRATE,2)
 20   ICHAR=ICHAR+6
      RETURN
      END
      SUBROUTINE ZPAUSE
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDUM(16),DUM(29)
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(9)
      ICHAR=ICHAR+2
      RETURN
      END
      SUBROUTINE ZETOBS(M256)
      COMMON /ZYYZ/IDUM1(1135),IOBLOK,IOBLKS,IDUM2(12),DUM(29)
      IOBLKS=M256*256
      IOBLOK=IOBLKS
      RETURN
      END
      SUBROUTINE SYMBOL(X,Y,SIZE,MESS,ANGLE,N)
      DIMENSION MESS(1),INDEX(308)
      LOGICAL*1 LTEMP(2)
      EQUIVALENCE (JTEMP,LTEMP)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,IOBLOK,
     + IDUM1(7),MONIT,IDUM2(5),OLDX,OLDY,DUM1(4),ASPCT,DUM2(22)
      DATA INDEX/64,19,20,64,22,23,109,64,26,27,28,29,31,74,95,
     + 64,90,127,123,91,108,80,125,77,93,92,78,107,96,75,97,112,
     + 113,114,115,116,117,118,119,120,121,122,94,76,126,110,
     + 111,124,65,66,67,68,69,70,71,72,73,81,82,83,84,85,86,87,
     + 88,89,98,99,100,101,102,103,104,105,53,55,54,18,24,34,35,
     + 36,37,38,39,40,41,42,43,44,45,64,64,48,49,50,51,52,56,57,
     + 58,59,60,61,62,63,33,79,32,30,106,
     + 34,35,36,37,38,39,40,41,42,43,44,45,56,48,27,52,57,49,61,
     + 23,22,50,51,19,31,20,62,60,63,29,106,74,64,90,127,123,91,
     + 108,80,125,77,93,92,78,107,96,75,97,112,113,114,115,116,
     + 117,118,119,120,121,122,94,76,126,110,111,124,65,66,67,68,
     + 69,70,71,72,73,81,82,83,84,85,86,87,88,89,98,99,100,101,
     + 102,103,104,105,53,55,54,18,24,26,128,129,130,131,132,133,
     + 134,135,136,137,138,139,140,141,142,143,144,145,146,147,
     + 148,149,150,151,152,153,33,79,32,30,109,95,28,58,59,154,
     + 155,156,157,158,159,160,161,162,163,164,165,166,167,168,
     + 169,170,171,172,173,174,175,176,177,178,179,180,181,182,
     + 183,184,185,186,187,188,189,190,191,192,193,194,195,196,
     + 197,198,199,200,201,202,203,204,205,206,207,208,209,210,
     + 211,212,213,214,215,216,217,218/
      XZ=X
      YZ=Y
      SIZASP=SIZE*ASPCT
      IF(ANGLE.NE.0.)GO TO 10
      ANGCOS=1.
      ANGSIN=0.
      GO TO 30
 10   IF(ANGLE.NE.90.)GO TO 20
      ANGCOS=0.
      ANGSIN=1.
      GO TO 30
 20   TEMP1=ANGLE*.0174532925
      ANGCOS=COS(TEMP1)
      ANGSIN=SIN(TEMP1)
 30   IF(X.EQ.999.)XZ=OLDX
      IF(Y.NE.999.)GO TO 40
      IF(X.EQ.999.)GO TO 50
      YZ=OLDY
 40   ITEMP=3
      IF(N.LT.-1)ITEMP=-N
      CALL PLOT(XZ,YZ,ITEMP)
 50   IF(N)140,130,60
 60   IOBUFF(ICHAR)=IASCI(4)
      ICHAR=ICHAR+1
      SIZASP=ABS(SIZASP)*N
      IDASHS=IDASH
      IDASH=-10
      CALL PLOT(SIZASP*ANGCOS+OLDX,SIZASP*ANGSIN+OLDY,IPENUP)
      IOBUFF(ICHAR)=IASCI(N/32+1)
      IOBUFF(ICHAR+1)=IASCI((N.AND."37)+1)
      ICHAR=ICHAR+2
      I=1
      IOFF=-16+128*MONIT
      IF(SIZE.GT.0.)GO TO 90
 70   J=I+29
      IF(J.GT.N)J=N
 80   ITEMP=INDEX((MESS(I).AND."377)+IOFF)
      IOBUFF(ICHAR)=IASCI(ITEMP/32+1)
      IOBUFF(ICHAR+1)=IASCI((ITEMP.AND."37)+1)
      ICHAR=ICHAR+2
      I=I+1
      IF(I.LE.J)GO TO 80
      IF(ICHAR.GT.IOBLOK)CALL PLOT(OLDX,OLDY,IPENUP)
      IF(J.NE.N)GO TO 70
      IDASH=IDASHS
      RETURN
 90   NWDS=(N+1)/2
 100  J=I+14
      IF(J.GT.NWDS)J=NWDS
 110  ITEMP=INDEX((MESS(I).AND."377)+IOFF)
      IOBUFF(ICHAR)=IASCI(ITEMP/32+1)
      IOBUFF(ICHAR+1)=IASCI((ITEMP.AND."37)+1)
      JTEMP=MESS(I)
      ITEMP=LTEMP(2)
      ITEMP=INDEX((ITEMP.AND."377)+IOFF)
      IOBUFF(ICHAR+2)=IASCI(ITEMP/32+1)
      IOBUFF(ICHAR+3)=IASCI((ITEMP.AND."37)+1)
      ICHAR=ICHAR+4
      I=I+1
      IF(I.LE.J)GO TO 110
      IF(J.EQ.NWDS)GO TO 120
      IF(ICHAR.GT.IOBLOK)CALL PLOT(OLDX,OLDY,IPENUP)
      GO TO 100
 120  IF(N.NE.NWDS*2)ICHAR=ICHAR-2
      IF(ICHAR.GT.IOBLOK)CALL PLOT(OLDX,OLDY,IPENUP)
      IDASH=IDASHS
      RETURN
 130  IOBUFF(ICHAR)=IASCI(4)
      ICHAR=ICHAR+1
      IDASHS=IDASH
      IDASH=-10
      CALL PLOT(SIZASP*ANGCOS+OLDX,SIZASP*ANGSIN+OLDY,IPENUP)
      IDASH=IDASHS
      IOBUFF(ICHAR)=IASCI(1)
      IOBUFF(ICHAR+1)=IASCI(2)
      ITEMP=INDEX(MESS(1)-16+128*MONIT)
      IOBUFF(ICHAR+2)=IASCI(ITEMP/32+1)
      IOBUFF(ICHAR+3)=IASCI((ITEMP.AND."37)+1)
      ICHAR=ICHAR+4
      RETURN
 140  IOBUFF(ICHAR)=IASCI(5)
      ICHAR=ICHAR+1
      SIZASP=SIZASP*1.75
      TEMP1=OLDX
      TEMP2=OLDY
      IDASHS=IDASH
      IDASH=-10
      CALL PLOT(SIZASP*ANGCOS+OLDX,SIZASP*ANGSIN+OLDY,IPENUP)
      IDASH=IDASHS
      OLDX=TEMP1
      OLDY=TEMP2
      IOBUFF(ICHAR)=IASCI(MESS(1)+1)
      ICHAR=ICHAR+1
      RETURN
      END
      SUBROUTINE AXIS(X,Y,MESS,NCHARS,AXLEN,ANGLE,FIRVAL,DELVAL)
      INTEGER   N1
      COMMON /ZYYZ/IDUM1(1133),IDASH,IDUM2(15),OLDX,OLDY,
     + DUM1(4),ASPCT,DUM2(22)
      DIMENSION MESS(1)
      DATA N1 /1/
      ISIDE=SIGN(N1,NCHARS)
      TEMP1=ANGLE*.0174533
      ANGCOS=COS(TEMP1)
      ANGSIN=SIN(TEMP1)
      IF(FIRVAL.NE.999.)GO TO 10
      NTIC=AXLEN/DELVAL+1.E-5
      TEMP1=ANGCOS*DELVAL
      TEMP2=ANGSIN*DELVAL
      GO TO 70
 10   IEXPT=0
      TEMP1=ABS(DELVAL)
 20   IF(TEMP1.GT.0.0099)GO TO 30
      TEMP1=TEMP1*10.
      IEXPT=IEXPT-1
      GO TO 20
 30   NTIC=AXLEN+1.E-5
      TEMP1=FIRVAL+NTIC*DELVAL
      TEMP1=MAX(ABS(FIRVAL),ABS(TEMP1))*10.**(-IEXPT)
 40   IF(TEMP1.LT.999.95)GO TO 50
      TEMP1=TEMP1/10.
      IEXPT=IEXPT+1
      GO TO 40
 50   TEMP1=10.**(-IEXPT)
      TICVAL=FIRVAL*TEMP1
      TICDEL=DELVAL*TEMP1
      TEMP1=ISIDE*.1575-.0525
      TEMP2=ASPCT*.105
      XX=X-TEMP1*ANGSIN-TEMP2*ANGCOS
      YY=Y+TEMP1*ANGCOS-TEMP2*ANGSIN
      DO 60 I=0,NTIC
      CALL NUMBER(XX,YY,.105,TICVAL,ANGLE,2)
      XX=XX+ANGCOS
      YY=YY+ANGSIN
      TICVAL=TICVAL+TICDEL
 60   CONTINUE
      TEMP1=ANGCOS
      TEMP2=ANGSIN
 70   XX=X+AXLEN*ANGCOS
      YY=Y+AXLEN*ANGSIN
      CALL PLOT(XX,YY,3)
      XX=X+NTIC*TEMP1
      YY=Y+NTIC*TEMP2
      CALL PLOT(XX,YY,2)
      ITEMP=IDASH
      IDASH=-10
      TICX=-.07*ANGSIN*ISIDE
      TICY=.07*ANGCOS*ISIDE
      CALL PLOT(XX+TICX,YY+TICY,2)
      CALL PLOT(XX,YY,2)
      DO 80 I=1,NTIC
      XX=XX-TEMP1
      YY=YY-TEMP2
      CALL PLOT(XX,YY,2)
      CALL PLOT(XX+TICX,YY+TICY,2)
      CALL PLOT(XX,YY,2)
 80   CONTINUE
      IDASH=ITEMP
      IF(FIRVAL.EQ.999.)RETURN
      IF(NCHARS.NE.0)GO TO 90
      IF(IEXPT.EQ.0)RETURN
 90   ITEMP=ABS(NCHARS)
      TEMP1=ISIDE*.35-.07
      TEMP2=.14*ITEMP
      IF(IEXPT.NE.0)TEMP2=TEMP2+.56
      TEMP2=(AXLEN-TEMP2*ASPCT)/2.
      CALL PLOT(X+TEMP2*ANGCOS-TEMP1*ANGSIN,
     + Y+TEMP2*ANGSIN+TEMP1*ANGCOS,3)
      IF(NCHARS.EQ.0)GO TO 110
      CALL SYMBOL(999.,999.,.14,MESS,ANGLE,ITEMP)
      IF(IEXPT.EQ.0)RETURN
 110  CALL SYMBOL(999.,999.,.14,4H *10,ANGLE,4)
      TEMP1=IEXPT
      CALL NUMBER(OLDX-.11*ANGSIN,OLDY+.11*ANGCOS,
     + .07,TEMP1,ANGLE,-1)
      RETURN
      END
      SUBROUTINE LINE(XARR,YARR,NPTS,KCYCLE,NDP,ILETT)
      DIMENSION XARR(1),YARR(1)
      COMMON /ZYYZ/IDUM(1149),DUM1(2),XOFF,XFACT,YOFF,YFACT,DUM2(23)
      IF(NPTS.LT.0)GO TO 50
      IPTS=NPTS
      INC=KCYCLE
      IF(NDP)10,40,20
 10   IPEN=3
      INCSYM=-NDP
      GO TO 30
 20   IPEN=2
      INCSYM=NDP
 30   I=IPTS*INC+1
      XO=XARR(I)
      YO=YARR(I)
      I=I+INC
      XF=XARR(I)
      YF=YARR(I)
      GO TO 70
 40   INCSYM=0
      IPEN=ILETT
      IF(IPEN.LT.10)GO TO 30
      GO TO 60
 50   INC=1
      IPTS=-NPTS
      INCSYM=ABS(NDP)
      IPEN=KCYCLE
      IF(IPEN.LT.10)GO TO 30
 60   IPEN=IPEN-10
      XO=XOFF
      YO=YOFF
      XF=XFACT
      YF=YFACT
 70   X=(XARR(1)-XO)/XF
      Y=(YARR(1)-YO)/YF
      CALL PLOT(X,Y,3)
      IF(INCSYM.GT.0)CALL SYMBOL(999.,999.,.08,ILETT,0.,-1)
      I=2
      J=1
      K=1
 80   K=K+INC
      X=(XARR(K)-XO)/XF
      Y=(YARR(K)-YO)/YF
      CALL PLOT(X,Y,IPEN)
      IF(J.NE.INCSYM)GO TO 90
      CALL SYMBOL(999.,999.,.08,ILETT,0.,-1)
      J=0
 90   IF(I.EQ.IPTS)RETURN
      I=I+1
      J=J+1
      GO TO 80
      END
      SUBROUTINE SCALE(ARRAY,AXLEN,NPTS,INC1)
      DIMENSION ARRAY(1)
      INC=ABS(INC1)
      AMAX=ARRAY(1)
      AMIN=AMAX
      J=1
      DO 40 I=2,NPTS
      J=J+INC
      X=ARRAY(J)
      IF(AMAX.GE.X)GO TO 20
      AMAX=X
      GO TO 40
20    IF(AMIN.LE.X)GO TO 40
      AMIN=X
40    CONTINUE
      IF(AMAX.NE.AMIN) GO TO 45
      X=AXLEN/3.
      AMAX=AMAX+X
      AMIN=AMIN-X
 45   FNUM=(AMAX-AMIN)/AXLEN
      POW=LOG10(FNUM)
      IPOW=POW+.01
      IF(POW.LT.0.)IPOW=POW-.99
      IDIG=(FNUM/10.**IPOW)+.99
 47   IF(IDIG-2)50,100,70
 50   IDIG=1
      GO TO 100
70    IF(IDIG-5)80,100,87
80    IDIG=4
      GO TO 100
87    IF(IDIG-8)88,100,90
88    IDIG=8
      GO TO 100
90    IPOW=IPOW+1
      GO TO 50
 100  FUDGE=10.**(IPOW-5)
      DELTAV=IDIG*10.**IPOW
      IF(AMIN)105,110,115
 105  FIRST=AINT(AMIN/(DELTAV+FUDGE)-1.)
      GO TO 120
 110  FIRST=0.
      GO TO 120
 115  FIRST=AINT(AMIN/(DELTAV-FUDGE))
 120  FIRSTV=DELTAV*FIRST+FUDGE
      ALASTV=FIRSTV+(AXLEN*DELTAV)
      IF(ALASTV.GE.AMAX)GO TO 140
      IDIG=IDIG+1
      GO TO 47
 140  NAME1=NPTS*INC+1
      NAME2=NAME1+INC
      IF(INC1.LT.0)GO TO 170
      ARRAY(NAME1)=FIRSTV
      ARRAY(NAME2)=DELTAV
      GO TO 180
170   ARRAY(NAME1)=ALASTV
      ARRAY(NAME2)=-DELTAV
180   RETURN
      END
      SUBROUTINE NUMBER(X,Y,SIZE1,FNUM1,ANGLE,NDEC1)
      DIMENSION MESBUF(40)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,
     + IDUM(14),OLDX,OLDY,DUM1(4),ASPCT,DUM2(22)
      XZ=X
      YZ=Y
      IF(ANGLE.NE.0.)GO TO 1
      ANGCOS=1.
      ANGSIN=0.
      GO TO 3
 1    IF(ANGLE.NE.90.)GO TO 2
      ANGCOS=0.
      ANGSIN=1.
      GO TO 3
 2    TEMP=ANGLE*.0174532925
      ANGCOS=COS(TEMP)
      ANGSIN=SIN(TEMP)
 3    IF(X.EQ.999.)XZ=OLDX
      IF(Y.NE.999.)GO TO 4
      IF(X.EQ.999.)GO TO 5
      YZ=OLDY
 4    CALL PLOT(XZ,YZ,3)
 5    FNUM=FNUM1
      NDEC=-NDEC1
      IF(NDEC.GT.0)NDEC=NDEC-1
      IBSIZE=1
      IPOW=0
      IF(FNUM)10,75,20
10    MESBUF(IBSIZE)=IASCI(11)
      IBSIZE=IBSIZE+1
      FNUM=-FNUM
20    FNUM=FNUM+.5*10.**NDEC
      POW=LOG10(FNUM)
      IPOW=POW
      IF(POW.GE.0.)GO TO 75
      IPOW=POW-1.
      MESBUF(IBSIZE)=IASCI(1)
      IBSIZE=IBSIZE+1
      IF(NDEC1.LT.0)GO TO 100
      IPOW=0
50    IF(NDEC1.LT.0)GO TO 70
      MESBUF(IBSIZE)=IASCI(12)
      IBSIZE=IBSIZE+1
70    IPOW=IPOW-1
75    IF(IPOW.LT.NDEC)GO TO 100
      IDIG=(FNUM/10.**IPOW)
      MESBUF(IBSIZE)=IASCI(IDIG+1)
      IBSIZE=IBSIZE+1
      FNUM=FNUM-(IDIG*(10.**IPOW))
      IF(IPOW.NE.0)GO TO 70
      GO TO 50
100   IBSIZE=IBSIZE-1
      IOBUFF(ICHAR)=IASCI(6)
      ICHAR=ICHAR+1
      TEMP=ASPCT*SIZE1*IBSIZE
      ITEMP=IDASH
      IDASH=-10
      CALL PLOT(TEMP*ANGCOS+OLDX,TEMP*ANGSIN+OLDY,IPENUP)
      IDASH=ITEMP
      IOBUFF(ICHAR)=IASCI(IBSIZE+1)
      ICHAR=ICHAR+1
      DO 110 K=1,IBSIZE
      IOBUFF(ICHAR)=MESBUF(K)
      ICHAR=ICHAR+1
110   CONTINUE
      RETURN
      END
      SUBROUTINE PLOTS(IREL,IDUMMY,LGUNIT)
      COMMON /ZYYZ/IDUM1(1101),IASCI(32),IDASH,IPENUP,IDUM2,
     + IOBLKS,ISBE,NDEV,IERR,IDUM3(3),MONIT,IPNUM,IPRIM,
     + ISTORE,IPSTAT,IDUM4,OLDX,OLDY,XOFF,XFACT,YOFF,YFACT,
     + ASPCT,PMSIZE,FACT,X0,Y0,DUM(18)
      DATA IASCI/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1HA,1HB,1HC,
     + 1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN,1HO,1HP,
     + 1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX/
      IOBLKS=1024
      IERR=1
      IF(LGUNIT.EQ.-1)GO TO 20
      IF(LGUNIT.EQ.0)GO TO 10
      NDEV=ABS(LGUNIT)
      IERR=-1
      GO TO 20
 10   IERR=0
 20   IDASH=-10
      IPENUP=3
      IF(IREL.NE.53)GO TO 30
      ISBE=-1
      MONIT=1
      GO TO 40
 30   ISBE=0
      MONIT=0
 40   IPNUM=1
      IPRIM=0
      ISTORE=1
      IPSTAT=-1
      OLDX=0.
      OLDY=0.
      XOFF=0.
      XFACT=1.
      YOFF=0.
      YFACT=1.
      ASPCT=1.
      PMSIZE=4.
      FACT=PMSIZE*100.
      X0=0.
      Y0=0.
      CALL PON
      RETURN
      END
      SUBROUTINE PON
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IDUM1(34),IOBLOK,IOBLKS,
     + IDUM2(2),IERR,IEO,IEOB1,IEOB2,IDUM3(6),DUM(29)
      DATA ICZ,IC9/1HZ,1H9/
      IOBLOK=IOBLKS
      DO 10 I=1,10
      IOBUFF(I)=ICZ
 10   CONTINUE
      ICHAR=11
      IF(IERR.NE.1)GO TO 20
      TYPE 1000
      IEO=2
      IEOB1=IC9
      IEOB2=IC9
 20   RETURN
 1000 FORMAT(1H ,20HZZZZZZZZZZZZZZZZZZZZ)
      END
      SUBROUTINE PLOT(X,Y,IP)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,IOBLOK,
     + IOBLKS,ISBE,NDEV,IERR,IEO,IEOB1,IEOB2,IDUM2(4),IPSTAT,IPLOC,
     + OLDX,OLDY,XOFF,XFACT,YOFF,YFACT,DUM(2),FACT,X0,Y0,DASH(3,6)
      DIMENSION IACK(2),IAC(4),IB32(43)
      DATA IAC,MASK/1HY,1H8,1H9,1HZ,"37/
      DATA IB32/0,1,2,3,4,5,6,7,9*0,8,9,10,11,12,13,14,15,16,
     + 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,0,0/
      XX=X
      YY=Y
 10   IF(IP.LT.0)GO TO 30
      IF(IP-998)40,610,20
 20   IPEN=3
      ASSIGN 530 TO IRET
      GO TO 60
 30   IPEN=-IP
      ASSIGN 520 TO IRET
      GO TO 50
 40   IPEN=IP
      ASSIGN 510 TO IRET
 50   IF(IPEN.LT.10)GO TO 60
      XX=(XX-XOFF)/XFACT
      YY=(YY-YOFF)/YFACT
      IPEN=IPEN-10
 60   DX=XX-OLDX
      DY=YY-OLDY
 65   DX1=DX*FACT
      IF(DX1)70,80,75
 70   IF(DX1.LT.-32400.)GO TO 760
      IDX=DX1-.5
      GO TO 85
 75   IF(DX1.GT.32400.)GO TO 760
      IDX=DX1+.5
      GO TO 85
 80   IDX=0
 85   DY1=DY*FACT
      IF(DY1)90,100,95
 90   IF(DY1.LT.-32400.)GO TO 770
      IDY=DY1-.5
      GO TO 105
 95   IF(DY1.GT.32400.)GO TO 770
      IDY=DY1+.5
      GO TO 105
 100  IDY=0
 105  IF(IDASH.NE.-10)GO TO 700
 110  IF(IPEN.EQ.IPENUP)GO TO 120
      IOBUFF(ICHAR)=IASCI(5-IPEN)
      ICHAR=ICHAR+1
      IPENUP=IPEN
 120  IKAR=ICHAR+1
      IF(IDX)140,130,150
 130  NBYTEX=1
      GO TO 230
 140  KXY=-IDX-1
      ISXY=1
      GO TO 160
 150  KXY=IDX
      ISXY=0
 160  IF(KXY.GT.15)GO TO 170
      NBYTEX=2
      JXY=32*ISXY+IDX
      GO TO 220
 170  IF(KXY.GT.511)GO TO 180
      NBYTEX=3
      JXY=1024*ISXY+IDX
      GO TO 210
 180  JXY=32767*ISXY+IDX+ISXY
      IF(KXY.GT.16383)GO TO 190
      NBYTEX=4
      GO TO 200
 190  NBYTEX=5
      IOBUFF(IKAR)=IASCI(ISXY*31+1)
      IKAR=IKAR+1
 200  ITEMP=JXY/1024
      IOBUFF(IKAR)=IASCI(ITEMP+1)
      IKAR=IKAR+1
 210  ITEMP=JXY/32
      ITEMP=ITEMP.AND.MASK
      IOBUFF(IKAR)=IASCI(ITEMP+1)
      IKAR=IKAR+1
      JXY=JXY.AND.MASK
 220  IOBUFF(IKAR)=IASCI(JXY+1)
      IKAR=IKAR+1
 230  IF(IDY)250,240,260
 240  NBYTEY=1
      IF(NBYTEX.GT.1)GO TO 340
      GO TO 350
 250  KXY=-IDY-1
      ISXY=1
      GO TO 270
 260  KXY=IDY
      ISXY=0
 270  IF(KXY.GT.15)GO TO 280
      NBYTEY=2
      JXY=32*ISXY+IDY
      GO TO 330
 280  IF(KXY.GT.511)GO TO 290
      NBYTEY=3
      JXY=1024*ISXY+IDY
      GO TO 320
 290  JXY=32767*ISXY+IDY+ISXY
      IF(KXY.GT.16383)GO TO 300
      NBYTEY=4
      GO TO 310
 300  NBYTEY=5
      IOBUFF(IKAR)=IASCI(ISXY*31+1)
      IKAR=IKAR+1
 310  ITEMP=JXY/1024
      IOBUFF(IKAR)=IASCI(ITEMP+1)
      IKAR=IKAR+1
 320  ITEMP=JXY/32
      ITEMP=ITEMP.AND.MASK
      IOBUFF(IKAR)=IASCI(ITEMP+1)
      IKAR=IKAR+1
      JXY=JXY.AND.MASK
 330  IOBUFF(IKAR)=IASCI(JXY+1)
      IKAR=IKAR+1
 340  IOBUFF(ICHAR)=IASCI(2+NBYTEY+5*NBYTEX)
      ICHAR=IKAR
 350  IF(ICHAR.LE.IOBLOK)GO TO IRET
      IF(IPSTAT.LT.0)GO TO 355
      CALL ZZZZ
      IF(IPSTAT.EQ.1)GO TO 353
      ICHAR=IPLOC
      GO TO IRET
 353  IPLOC=ICHAR-IOBLOK
 355  ICHAR=ICHAR-IOBLOK
      IF(IERR)500,490,360
 360  ICHKS=0
      DO 370 I=1,IOBLOK
      ITEMP=IOBUFF(I)-8239
      ICHKS=ICHKS+IB32(ITEMP)
 370  CONTINUE
      ICHKS=ICHKS.AND.MASK
 380  TYPE 1000,(IOBUFF(I),I=1,IOBLOK)
      TYPE 2000,IEOB1,IASCI(ICHKS+1),IEOB2
 390  ACCEPT 3000,IACK
      DO 420 I=1,2
      DO 400 J=1,4
      ITEMP=J
      IF(IACK(I).EQ.IAC(J))GO TO 410
 400  CONTINUE
      GO TO 390
 410  IACK(I)=ITEMP
 420  CONTINUE
      DO 430 I=1,2
      ITEMP=I
      J=IACK(3-I)-2
      IF(IACK(I)-2)450,440,430
 430  CONTINUE
      GO TO 390
 440  IF(J+IEO.NE.3)GO TO 460
      IF(IACK(ITEMP).EQ.2)GO TO 380
      GO TO 390
 450  IF(J.NE.IEO)GO TO 390
 460  IEO=3-IEO
 470  ISBE=ISBE*ISBE
      IF(ICHAR.EQ.1)GO TO IRET
      ITEMP=ICHAR-1
      DO 480 I=1,ITEMP
      IOBUFF(I)=IOBUFF(I+IOBLOK)
 480  CONTINUE
      GO TO IRET
 490  TYPE 1000,(IOBUFF(I),I=1,IOBLOK)
      GO TO 470
 500  WRITE(NDEV,4000)(IOBUFF(I),I=1,IOBLOK)
      GO TO 470
 510  OLDX=OLDX+IDX/FACT
      OLDY=OLDY+IDY/FACT
      RETURN
 520  OLDX=(IDX-DX1)/FACT
      OLDY=(IDY-DY1)/FACT
      X0=X0+XX
      Y0=Y0+YY
      RETURN
 530  IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(1)
      ICHAR=ICHAR+2
      IF(IERR.EQ.1)GO TO 540
      IOBUFF(ICHAR)=IASCI(1)
      ICHAR=ICHAR+1
 540  IF(ICHAR-IOBLOK-1)560,590,550
 550  ASSIGN 560 TO IRET
      ICHAR=ICHAR-IOBLOK
      IF(IERR)500,490,360
 560  IF(ISBE.LE.0)GO TO 570
      IOBLKS=IOBLOK
      IOBLOK=(ICHAR+62).AND.(-64)
      IF(ICHAR.GT.IOBLOK)GO TO 590
 570  ITEMP=IASCI(1)
      DO 580 I=ICHAR,IOBLOK
      IOBUFF(I)=ITEMP
 580  CONTINUE
 590  ICHAR=1
      ASSIGN 690 TO IRET
      IF(IERR.NE.1)GO TO 600
      IEOB1=IAC(4)
      IEOB2=IEOB1
      GO TO 360
 600  IOBUFF(IOBLOK)=IAC(4)
      IF(IERR.EQ.0)GO TO 490
      GO TO 500
 610  IF(IERR.EQ.1)GO TO 620
      IOBUFF(ICHAR)=IASCI(1)
      IOBUFF(ICHAR+1)=IASCI(1)
      ICHAR=ICHAR+2
 620  IF(ICHAR-IOBLOK-1)640,670,630
 630  ASSIGN 640 TO IRET
      ICHAR=ICHAR-IOBLOK
      IF(IERR.EQ.1)GO TO 360
      GO TO 490
 640  IF(ISBE.LE.0)GO TO 650
      IOBLKS=IOBLOK
      IOBLOK=(ICHAR+62).AND.(-64)
      IF(ICHAR.GT.IOBLOK)GO TO 670
 650  ITEMP=IASCI(1)
      DO 660 I=ICHAR,IOBLOK
      IOBUFF(I)=ITEMP
 660  CONTINUE
 670  ICHAR=1
      ASSIGN 690 TO IRET
      IF(IERR.NE.1)GO TO 680
      IEOB1=IAC(4)
      GO TO 360
 680  IOBUFF(IOBLOK-1)=IAC(4)
      IOBUFF(IOBLOK)=IAC(4)
      GO TO 490
 690  RETURN
 700  IF(IPEN-3)710,110,720
 710  IF(IDASH.LE.0)GO TO 110
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(11)
      ICHAR=ICHAR+2
      IDASH=-IDASH
      GO TO 110
 720  ITEMP=IPEN-3
      IPEN=2
      IF(IDASH.EQ.ITEMP)GO TO 110
      IF(IDASH.NE.-ITEMP)GO TO 730
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(10)
      ICHAR=ICHAR+2
      IDASH=-IDASH
      GO TO 110
 730  IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(12)
      ICHAR=ICHAR+2
      IRET1=IRET
      ASSIGN 740 TO IRET
      IDXS=IDX
      IDYS=IDY
      IDASH=ITEMP
      IDX=DASH(1,IDASH)*FACT+.5
      IDY=DASH(2,IDASH)*FACT+.5
      IKAR=ICHAR+1
      GO TO 150
 740  IDX=DASH(3,IDASH)*FACT+.5
      IDY=0
      ASSIGN 750 TO IRET
      IKAR=ICHAR+1
      GO TO 150
 750  IDX=IDXS
      IDY=IDYS
      IRET=IRET1
      GO TO 110
 760  IF(ABS(DY).GT.ABS(DX))GO TO 770
      TEMP=SIGN(32000./FACT,DX)
      YT=DY*TEMP/DX
      XT=DX-TEMP
      DX=TEMP
      TEMP=YT
      YT=DY-TEMP
      DY=TEMP
      GO TO 780
 770  TEMP=SIGN(32000./FACT,DY)
      XT=DX*TEMP/DY
      YT=DY-TEMP
      DY=TEMP
      TEMP=XT
      XT=DX-TEMP
      DX=TEMP
 780  IRET2=IRET
      ASSIGN 790 TO IRET
      GO TO 65
 790  DX=XT
      DY=YT
      OLDX=OLDX+IDX/FACT
      OLDY=OLDY+IDY/FACT
      IRET=IRET2
      GO TO 65
 1000 FORMAT(1H ,64A1)
 2000 FORMAT(1H ,3A1)
 3000 FORMAT(2A1)
 4000 FORMAT(64A1)
      END
      SUBROUTINE DASHDF(I,DOWN1,UP,DOWN2)
      DIMENSION DDINIT(3,6)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IDUM(15),
     + DUM(11),DASH(3,6)
      DATA DDINIT/.15,.07,.15,.04,.15,.04,
     + .25,.25,.25,.15,.06,.04,.5,.1,.1,2.,.1,.1/
      IF(I)10,50,30
 10   II=-I-3
      DO 20 J=1,3
      DASH(J,II)=DDINIT(J,II)
 20   CONTINUE
      GO TO 40
 30   II=I-3
      DASH(1,II)=DOWN1
      DASH(2,II)=UP
      DASH(3,II)=DOWN2
 40   IF(ABS(IDASH).EQ.II) GO TO 80
      IF(IDASH.EQ.-10) IDASH=0
      RETURN
 50   DO 70 J=1,3
      DO 60 K=1,6
      DASH(J,K)=DDINIT(J,K)
 60   CONTINUE
 70   CONTINUE
 80   IF(IDASH.LE.0)GO TO 90
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(11)
      ICHAR=ICHAR+2
 90   IDASH=0
      RETURN
      END
      SUBROUTINE ZZZZ
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IDUM1(45),ISTORE,IDUM2,
     + IPLOC,DUM(29)
      COMMON /ZXXZ/IPA(1)
      ICHRM1=ICHAR-1
      J=ISTORE+IPA(1)-IPLOC
      DO 10 I=IPLOC,ICHRM1
      IPA(J+I)=IOBUFF(I)
 10   CONTINUE
      ISTORE=ISTORE+ICHAR-IPLOC
      RETURN
      END
      SUBROUTINE PRIME
      COMMON /ZYYZ/IDUM1(1145),IPRIM,IDUM2(3),DUM(29)
      IPRIM=1
      RETURN
      END
      SUBROUTINE ZPATSZ(NUMPAT,ISIZ)
      COMMON /ZYYZ/IDUM1(1146),ISTORE,IDUM2(2),DUM(29)
      COMMON /ZXXZ/IPA(1)
      IF(NUMPAT.NE.0)GO TO 10
      ISIZ=ISTORE+IPA(1)
      RETURN
 10   ISIZ=3*NUMPAT+1
      ISIZ=IPA(ISIZ)-IPA(ISIZ-3)+4
      RETURN
      END
      SUBROUTINE ITALIC(SLA)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,
     + IDUM(14),OLDX,OLDY,DUM1(6),FACT,DUM2(20)
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(13)
      ICHAR=ICHAR+2
      IF(SLA.NE.0.)GO TO 100
      IOBUFF(ICHAR)=IASCI(13)
      IOBUFF(ICHAR+1)=IASCI(1)
      ICHAR=ICHAR+2
      RETURN
 100  OLDXS=OLDX
      RAD=SLA*.0174532925
      ITEMP=IDASH
      IDASH=-10
      CALL PLOT(256.*SIN(RAD)/(COS(RAD)*FACT)+OLDX,OLDY,IPENUP)
      IDASH=ITEMP
      OLDX=OLDXS
      RETURN
      END
      SUBROUTINE ASPECT(ASP)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,
     + IDUM(14),OLDX,OLDY,DUM1(4),ASPCT,DUM2,FACT,DUM3(20)
      ASPCT=ASP
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(14)
      ICHAR=ICHAR+2
      OLDXS=OLDX
      ITEMP=IDASH
      IDASH=-10
      CALL PLOT(256./(ASP*FACT)+OLDX,OLDY,IPENUP)
      IDASH=ITEMP
      OLDX=OLDXS
      RETURN
      END
      SUBROUTINE ZMESS(MESS,NCHARS)
      DIMENSION MESS(1)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,
     + IOBLOK,IDUM(13),OLDX,OLDY,DUM(27)
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(16)
      IOBUFF(ICHAR+2)=IASCI(NCHARS/32+1)
      IOBUFF(ICHAR+3)=IASCI((NCHARS.AND."37)+1)
      ICHAR=ICHAR+4
      NWDS=(NCHARS+1)/2
      IDASHS=IDASH
      IDASH=-10
      I=1
 10   J=I+14
      IF(J.GT.NWDS)J=NWDS
 20   ITEMP=MESS(I).AND."377
      IOBUFF(ICHAR)=IASCI(ITEMP/32+1)
      IOBUFF(ICHAR+1)=IASCI((ITEMP.AND."37)+1)
      ITEMP=MESS(I)/256
      IOBUFF(ICHAR+2)=IASCI(ITEMP/32+1)
      IOBUFF(ICHAR+3)=IASCI((ITEMP.AND."37)+1)
      ICHAR=ICHAR+4
      I=I+1
      IF(I.LE.J)GO TO 20
      IF(J.EQ.NWDS)GO TO 30
      IF(ICHAR.GT.IOBLOK)CALL PLOT(OLDX,OLDY,IPENUP)
      GO TO 10
 30   IF(NCHARS.NE.NWDS*2)ICHAR=ICHAR-2
      IF(ICHAR.GT.IOBLOK)CALL PLOT(OLDX,OLDY,IPENUP)
      IDASH=IDASHS
      RETURN
      END
      SUBROUTINE CIRCLE(X,Y,THS,THE,RAD,LINTYP)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,IPENUP,
     + IDUM(14),OLDX,OLDY,DUM(9),DASH(3,6)
      XX=X
      YY=Y
      IF(X.EQ.999.)XX=OLDX
      IF(Y.NE.999.)GO TO 10
      IF(X.EQ.999.)GO TO 20
      YY=OLDY
 10   CALL PLOT(XX,YY,3)
 20   IF(LINTYP.GE.4)GO TO 30
      IF(IDASH.LE.0)GO TO 60
      IOBUFF(ICHAR+1)=IASCI(11)
      GO TO 50
 30   ITEMP=LINTYP-3
      IF(ITEMP.EQ.IDASH)GO TO 70
      IF(ITEMP.EQ.-IDASH)GO TO 40
      IDASH=-10
      XX=OLDX
      YY=OLDY
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(12)
      ICHAR=ICHAR+2
      CALL PLOT(OLDX+DASH(1,ITEMP),OLDY+DASH(2,ITEMP),IPENUP)
      CALL PLOT(OLDX+DASH(3,ITEMP),OLDY,IPENUP)
      OLDX=XX
      OLDY=YY
      GO TO 75
 40   IOBUFF(ICHAR+1)=IASCI(10)
 50   IOBUFF(ICHAR)=IASCI(8)
      ICHAR=ICHAR+2
      IDASH=-IDASH
 60   ITEMP=IDASH
 70   IDASH=-10
 75   TEMP1=THS*.0174533
      TEMP2=RAD*SIN(TEMP1)
      TEMP1=RAD*COS(TEMP1)
      XX=OLDX+TEMP1
      YY=OLDY+TEMP2
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(15)
      ICHAR=ICHAR+2
      IF(MOD(THS-THE+360.05,360.).GT.(.1))GO TO 80
      TEMP1=OLDX
      TEMP2=OLDY
      CALL PLOT(XX,YY,IPENUP)
      OLDX=TEMP1
      OLDY=TEMP2
      IDASH=ITEMP
      RETURN
 80   IF(THS.LT.THE)GO TO 90
      IOBUFF(ICHAR)=IASCI(2)
      GO TO 100
 90   IOBUFF(ICHAR)=IASCI(1)
 100  ICHAR=ICHAR+1
      CALL PLOT(XX,YY,IPENUP)
      OLDX=OLDX-2.*TEMP1
      OLDY=OLDY-2.*TEMP2
      TEMP1=THE*.0174533
      CALL PLOT(OLDX+RAD*COS(TEMP1),OLDY+RAD*SIN(TEMP1),IPENUP)
      IDASH=ITEMP
      RETURN
      END
      SUBROUTINE ORIGIN(X,Y,IORIG)
      COMMON /ZYYZ/IDUM(1149),OLDX,OLDY,DUM1(7),X0,Y0,DUM2(18)
      IF(IORIG)10,20,30
 10   X=X0
      Y=Y0
      RETURN
 20   OLDX=OLDX+X0-X
      OLDY=OLDY+Y0-Y
      X0=X
      Y0=Y
      RETURN
 30   OLDX=OLDX-X
      OLDY=OLDY-Y
      X0=X0+X
      Y0=Y0+Y
      RETURN
      END
      SUBROUTINE SHADE(NSHADS,THICK)
      COMMON /ZYYZ/ICHAR,IOBUFF(1100),IASCI(32),IDASH,
     + IPENUP,IDUM(14),OLDX,OLDY,DUM1(6),FACT,DUM2(20)
      IOBUFF(ICHAR)=IASCI(8)
      IOBUFF(ICHAR+1)=IASCI(17)
      IF(NSHADS.EQ.0)GO TO 10
      ITHICK=THICK*256./NSHADS
      ICHAR=ICHAR+2
      OLDXS=OLDX
      OLDYS=OLDY
      IDASHS=IDASH
      IDASH=-10
      CALL PLOT(OLDX+NSHADS/FACT,OLDY+ITHICK/FACT,IPENUP)
      IDASH=IDASHS
      OLDX=OLDXS
      OLDY=OLDYS
      RETURN
 10   IOBUFF(ICHAR+2)=IASCI(13)
      IOBUFF(ICHAR+3)=IASCI(1)
      ICHAR=ICHAR+4
      RETURN
      END
      SUBROUTINE FPLOT(X,Y,IP)
      INTEGER   N2, N100
      COMMON /ZYYZ/IDUM(1149),OLDX,OLDY,XOFF,XFACT,
     + YOFF,YFACT,DUM(23)
      COMMON /ZWWZ/IBFCNT,IBUF0,NOK,ITEST,IPEN,BAND,XYBUF(200)
      DATA N2,N100 /2,100/
      IF(IP-1)10,20,30
 10   IF(IBFCNT-1)25,170,60
 20   BAND=X
      IBFCNT=0
      NOK=1
 25   IBUF0=0
      ITEST=2
      RETURN
 30   IF(IP.LT.10)GO TO 40
      XX=(X-XOFF)/XFACT
      YY=(Y-YOFF)/YFACT
      IPEN=IP-10
      GO TO 50
 40   XX=X
      YY=Y
      IPEN=IP
 50   IBFCNT=IBFCNT+1
      I=IBFCNT+IBUF0
      J=I-100
      IF(J.GT.0)I=J
      XYBUF(I)=XX
      XYBUF(I+100)=YY
      IF(IBFCNT.LT.ITEST)RETURN
 60   JTEST=IBFCNT
 70   I=JTEST+IBUF0
      J=I-100
      IF(J.GT.0)I=J
      XX=XYBUF(I)
      YY=XYBUF(I+100)
      DX=XX-OLDX
      DY=YY-OLDY
      ADX=ABS(DX)
      ADY=ABS(DY)
      JTSTM1=JTEST-1
      IF(ADX-ADY)120,80,100
 80   IF(DX.NE.0.)GO TO 100
      DO 90 I=1,JTSTM1
      J=I+IBUF0
      K=J-100
      IF(K.GT.0)J=K
      IF(ABS(XYBUF(J)-OLDX).GT.BAND)GO TO 150
      IF(ABS(XYBUF(J+100)-OLDY).GT.BAND)GO TO 150
 90   CONTINUE
      GO TO 140
 100  SLOPE=DY/DX
      CEPT1=OLDY-SLOPE*OLDX
      CEPT2=CEPT1-BAND
      CEPT1=CEPT1+BAND
      ADX=ADX+BAND
      DO 110 I=1,JTSTM1
      J=I+IBUF0
      K=J-100
      IF(K.GT.0)J=K
      XXX=XYBUF(J)
      YYY=XYBUF(J+100)
      IF(ABS(OLDX-XXX)+ABS(XX-XXX).GT.ADX)GO TO 150
      XXX=XXX*SLOPE
      IF(YYY.GT.XXX+CEPT1)GO TO 150
      IF(YYY.LT.XXX+CEPT2)GO TO 150
 110  CONTINUE
      GO TO 140
 120  SLOPE=DX/DY
      CEPT1=OLDX-SLOPE*OLDY
      CEPT2=CEPT1-BAND
      CEPT1=CEPT1+BAND
      ADY=ADY+BAND
      DO 130 I=1,JTSTM1
      J=I+IBUF0
      K=J-100
      IF(K.GT.0)J=K
      YYY=XYBUF(J+100)
      XXX=XYBUF(J)
      IF(ABS(OLDY-YYY)+ABS(YY-YYY).GT.ADY)GO TO 150
      YYY=YYY*SLOPE
      IF(XXX.GT.YYY+CEPT1)GO TO 150
      IF(XXX.LT.YYY+CEPT2)GO TO 150
 130  CONTINUE
 140  NOK=JTEST
      IF(NOK.NE.IBFCNT)GO TO 160
      IF(IP.EQ.0)GO TO 170
      IF(NOK.EQ.100)GO TO 170
      ITEST=MIN(N100,N2*NOK)
      RETURN
 150  NBAD=JTEST
 160  JTEST=(NBAD+NOK)/2
      IF(JTEST.GT.NOK)GO TO 70
 170  I=NOK+IBUF0
      J=I-100
      IF(J.GT.0)I=J
      CALL PLOT(XYBUF(I),XYBUF(I+100),IPEN)
      IBUF0=I
      IBFCNT=IBFCNT-NOK
      ITEST=NOK
      NOK=1
      IF(IP.EQ.0)GO TO 180
      RETURN
 180  IF(IBFCNT.NE.0)GO TO 60
      GO TO 25
      END
C
C     THE FOLLOWING MAIN PROGRAM IS INTENDED TO BE USED
C     WITH SUBROUTINE UTIL53 (WHICH FOLLOWS IMMEDIATELY
C     AFTER).  ITS FUNCTION IS TO INTERROGATE THE TERMINAL
C     FOR THE NAME OF THE PLOTFILE, OPEN THE FILE, AND
C     CALL UTIL53 WITH APPROPRIATE ARGUMENTS.
C
      TYPE 1000
      CALL ASSIGN(2,,-1)
      TYPE 2000
      ACCEPT 3000,M256
      CALL UTIL53(2,M256)
      STOP
 1000 FORMAT(1H ,23HENTER (DEVICE:)FILENAME,/)
 2000 FORMAT(1H ,29HENTER BLOCK SIZE (1,2,3,OR 4))
 3000 FORMAT(I1)
      END
C
C
C
      SUBROUTINE UTIL53(NDEV,M256)
      DIMENSION IOBUFF(1024),IASCI(32),IACK(2),IAC(4),IB32(43)
      DATA IASCI/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1HA,1HB,
     + 1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,1HM,1HN,
     + 1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX/
      DATA IAC,IC9,ICZ,IC0/1HY,1H8,1H9,1HZ,1H9,1HZ,1H0/
      DATA IB32/0,1,2,3,4,5,6,7,9*0,8,9,10,11,12,13,14,15,16,
     + 17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,0,0/
      NRECS=M256*4
 10   J=1
      DO 30 I=1,NRECS
      K=J+63
      READ(NDEV,1000,END=160)(IOBUFF(L),L=J,K)
      IF(IOBUFF(J).NE.ICZ)GO TO 20
      TYPE 2000
      IEOB=IC9
      IEO=2
 20   IF(IOBUFF(K).EQ.ICZ)GO TO 40
      J=J+64
 30   CONTINUE
      GO TO 50
 40   IEOB=ICZ
      IOBUFF(K)=IC0
 50   ICHKS=0
      DO 60 I=1,K
      J=IOBUFF(I)-8239
      ICHKS=ICHKS+IB32(J)
 60   CONTINUE
      ICHKS=ICHKS.AND.31
 70   TYPE 3000,(IOBUFF(I),I=1,K)
      TYPE 4000,IEOB,IASCI(ICHKS+1),IEOB
 80   ACCEPT 5000,IACK
      DO 110 I=1,2
      DO 90 J=1,4
      L=J
      IF(IACK(I).EQ.IAC(J))GO TO 100
 90   CONTINUE
      GO TO 80
 100  IACK(I)=L
 110  CONTINUE
      DO 120 I=1,2
      J=IACK(3-I)-2
      L=I
      IF(IACK(I)-2)140,130,120
 120  CONTINUE
      GO TO 80
 130  IF(J+IEO.NE.3)GO TO 150
      IF(IACK(L).EQ.2)GO TO 70
      GO TO 80
 140  IF(J.NE.IEO)GO TO 80
 150  IEO=3-IEO
      GO TO 10
 160  RETURN
 1000 FORMAT(64A1)
 2000 FORMAT(1H ,20HZZZZZZZZZZZZZZZZZZZZ)
 3000 FORMAT(1H ,64A1)
 4000 FORMAT(1H ,3A1)
 5000 FORMAT(2A1)
      END
