FTN4,L
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    C
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- C
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  C
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C      NAME:    SYMBR -- DVZ12 CHECKOUT 
C      SOURCE:  92840-18109 
C      RELOC:   92840-16012 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
      PROGRAM SYMBR(,51),  92840-16012 REV.2040 800807
C 
C****************************************************************** 
C 
C   MODIFIED BY PHIL P. OF BOISE TO CORRECT ABORT PROBLEM 
C          WHEN LABELS EXTEND BEYOND LOGICAL LIMITS FOR THE 2040 PCO
C 
C*******************************************************************
C 
      DIMENSION IPRAM(5),IEQT(20),IBUFR(133),IPLTB(1040)
     1 ,ITEMP(50) 
      INTEGER FNAME 
      DIMENSION LU(3),FNAME(3)
      EQUIVALENCE (IPRAM,IBUFF),(IEQTP,IPRAM(2)),(IEQT(10),EANG)
      EQUIVALENCE (IPRAM(3),IPNT1),(IEQT(6),SCALE)
      CALL RMPAR(IPRAM) 
      IF (IPRAM.EQ.0)STOP 
      CALL Z12RV(IEQTP,IEQT,IBUFF,IBUFR)
      LU(1)=-IEQT(1)
      LU(2)=IEQT(5) 
      LU(3)=IEQT(15)
      DO 5 I=1,3
    5 FNAME(I)=IEQT(I+1)
      X=IEQT(8) 
      Y=IEQT(9)                                                               
      IF (X.LT.0.) GO TO 211                                            PP2040
      IF (Y.LT.0.) GO TO 211                                            PP2040
      IF (X.GT.920.)GO TO 211                                           PP2040
      YMAX=72*IEQT(16)                                                  PP2040
      IF (Y.GT.YMAX)GO TO 211                                           PP2040
      XMAX=920.                                                         PP2040
      THETA=EANG
      ILEN=IEQT(16) 
      CALL Z12IN(LU,1,IERR,FNAME,ILEN,IPLTB,1040,0) 
      CALL Z12WD(IEQT(12))
      CALL Z12MD(IEQT(13))
      N=IBUFR(1)/2
      IT1=IBUFR(N+1)/400B 
      IT2=IBUFR(N+1)-IT1*400B 
      IF(IT2.EQ.40B)IBUFR(1)=IBUFR(1)-1 
      ILF=0 
      IF((IT2.EQ.137B).OR.((IT2.EQ.40B).AND.(IT1.EQ.137B)))ILF=1
      IF (ILF.EQ.1)IBUFR(1)=IBUFR(1)-1
      IF(IEQT(14).EQ.-1)GO TO 200 
      SINT=SIN(THETA) 
      COST=COS(THETA) 
      PORX=X-7*SCALE*SINT 
      PORY=Y+7*SCALE*COST 
      DO 100 I=1,IBUFR
      J=(I-1)/2 
      IT1=IBUFR(J+2)/256
      IT2=IBUFR(J+2)-IT1*256
      DO 80 J=1,50
   80 ITEMP(K)=0
      IF (2*(I/2).EQ.I)IT1=IT2
      NUM=1 
      CALL Z12FN(IEQT(1),IRBLU) 
      CALL Z12CV(IEQT(14),ITEMP,IT1,NUM,IRBLU)
      IF(ITEMP(1).EQ.10000)GO TO 103
      K=1 
      L=K 
      DO 90 J=2,NUM 
      IF((ITEMP(J).GT.10000).OR.(ITEMP(J).EQ.0))GO TO 92
      L=L+1 
   90 CONTINUE
   92 CONTINUE
      DO 93 J=K,L 
      IVL=ITEMP(J)
      IF (IVL.GT.10000)IVL=IVL-10000
      IF (IVL.EQ.0)GO TO 103
      IX1=IVL/100 
      IX2=IVL-IX1*100 
      IPX1=IX1/10 
      IPY1=IX1-IPX1*10
      IPX2=IX2/10 
      IPY2=IX2-IPX2*10
      PX1=FLOAT(IPX1-1)*SCALE 
      PY1=FLOAT(IPY1-1)*SCALE 
      PX2=FLOAT(IPX2-1)*SCALE 
      PY2=FLOAT(IPY2-1)*SCALE 
      PX=PORX+PX1*COST+PY1*SINT+.5
      PY=PORY+PX1*SINT-PY1*COST+.5
      IF(PX.GT.XMAX.OR.PX.LT.0)GO TO 93                                 PP2040
      IF(PY.GT.YMAX.OR.PY.LT.0)GO TO 93                                 PP2040
      CALL Z12PT(PX,PY,3) 
      PX=PORX+PX2*COST+PY2*SINT+.5
      PY=PORY+PX2*SINT-PY2*COST+.5
      IF(PX.GT.XMAX.OR.PX.LT.0)GO TO 93                                 PP2040
      IF(PY.GT.YMAX.OR.PY.LT.0)GO TO 93                                 PP2040
      CALL Z12PT (PX,PY,2)
   93 CONTINUE
  103 PORX=PORX+7*COST*SCALE
  100 PORY=PORY+7*SINT*SCALE
      GO TO 210 
  211 IDX=200.                                                          PP2040
      IDY=200.                                                          PP2040
      GO TO 212                                                         PP2040
  200 CONTINUE
      CALL Z12SB(X,Y,SCALE,IBUFR,THETA,0) 
  210 CALL Z12CL
      ANGLE=THETA-1.570796327 
      IF (ANGLE.LT.0.0)ANGLE=ANGLE+6.283185308
      DX=COS(ANGLE)*SCALE*10.0
      DY=SIN(ANGLE)*SCALE*10.0
      IF(ILF.EQ.1)DX=COS(THETA)*SCALE*7.*IBUFR(1) 
      IF(ILF.EQ.1)DY=SIN(THETA)*SCALE*7.*IBUFR(1) 
      IDX=DX
      IDY=DY
  212 CALL Z12RL(IEQTP,IPNT1,IDX,IDY)                                   PP2040
      END 
C 
C 
C 
      SUBROUTINE Z12CV (ICHST,IBFF,ICHR,NUM,LU) 
      DIMENSION IBFF(100),ITEMP(63),IVEC(40),IMSK(7),IDOT(7,9)
     1,ITP(16)
      DATA ITP/0,10000B,20000B,30000B,40000B,50000B,60000B,70000B 
     1,100000B,110000B,120000B,130000B,140000B,150000B,160000B,170000B/ 
      IF ((ICHST.GT.15).OR.(ICHST.LT.0))ICHST=0 
      ICHT=ITP(ICHST+1)+ICHR
      INUM=NUM*9+1
      CALL EXEC(1,LU,IBFF,INUM,ICHT)
      JCNT=0
    5 DO 100 K=1,NUM
      DO 6 I=1,7
    6 IMSK(I)=2**(7-I)
      DO 11 J=1,9 
      L=(K-1)*9+J+1 
      DO 10 I=1,7 
      IDOT(I,J)=0 
      L1=(J-1)*7+I
      IF (IAND(IBFF(L),IMSK(I)).EQ.0) GO TO 10
      IDOT(I,J)=1 
   10 ITEMP(L1)=IDOT(I,J) 
   11 CONTINUE
      L=0 
      DO 30 J=1,9 
      DO 25 I=1,7 
      IF (IDOT(I,J).EQ.0)GO TO 25 
      DO 22 M=I,7 
      IF (IDOT(M,J).EQ.0)GO TO 23 
      IDOT(M,J)=0 
   22 M1=M
   23 IF(M1.EQ.I)GO TO 25 
      L=L+1 
      IVEC(L)=I*1000+J*100+M1*10+J
   25 CONTINUE
      DO 30 M1=1,7
      L1=(J-1)*7+M1 
   30 IDOT(M1,J)=ITEMP(L1)
      DO 40 I=1,7 
      DO 35 J=1,9 
      IF (IDOT(I,J).EQ.0)GO TO 35 
      DO 32 M=J,9 
      IF (IDOT(I,M).EQ.0)GO TO 33 
      IDOT(I,M)=0 
   32 M1=M
   33 IF(J.EQ.M1)GO TO 35 
      L=L+1 
      IVEC(L)=I*1000+J*100+I*10+M1
   35 CONTINUE
      DO 40 M1=1,9
      L1=(M1-1)*7+I 
   40 IDOT(I,M1)=ITEMP(L1)
      DO 50 J=1,8 
      DO 50 I=1,6 
      IF (IDOT(I,J).EQ.0)GO TO 50 
      IF (IDOT(I+1,J+1).EQ.0)GO TO 50 
      IF (IDOT(I,J+1).EQ.1)GO TO 50 
      IF (IDOT(I+1,J).EQ.1)GO TO 50 
      L=L+1 
      IVEC(L)=I*1000+J*100+(I+1)*10+(J+1) 
   50 CONTINUE
      DO 60 J=1,8 
      DO 60 I=2,7 
      IF (IDOT(I,J).EQ.0)GO TO 60 
      IF(IDOT(I-1,J+1).EQ.0)GO TO 60
      IF(IDOT(I-1,J).EQ.1)GO TO 60
      IF(IDOT(I,J+1).EQ.1)GO TO 60
      L=L+1 
      IVEC(L)=I*1000+J*100+(I-1)*10+(J+1) 
   60 CONTINUE
      DO 70 I=1,L-1 
      M=I+1 
      DO 70 J=M,L 
      IF(IVEC(J).NE.IVEC(I))GO TO 70
      L=L-1 
      DO 65 M1=J,L
   65 IVEC(M1)=IVEC(M1+1) 
   70 CONTINUE
      DO 280 I=1,L-1
      IX1=IVEC(I)/100 
      IX2=IVEC(I)-IX1*100 
      IX3=IX1/10
      IY3=IX1-10*IX3
      IX4=IX2/10
      IY4=IX2-IX4*10
      IF (IX2.EQ.IX1+1)GO TO 150
      IF (IX2.EQ.IX1+10)GO TO 140 
      GO TO 280 
  140 DO 145 M1=I+1,L 
      IY1=IVEC(M1)/100
      IY2=IVEC(M1)-IY1*100
      IF (IY4.EQ.1)GO TO 141
      IF((IX1.EQ.IY1).AND.(IY2.EQ.IY1-9).AND.(IDOT(IX4,IY4-1).EQ.1))
     1 IX2=IX2-1
  141 IF (IY3.EQ.1)GO TO 142
      IF ((IX2.EQ.IY1).AND.(IY2.EQ.IY1+11).AND.(IDOT(IX3,IY3-1).EQ.1))
     1 IX1=IX1-1
  142 IF (IY4.EQ.9)GO TO 143
      IF ((IX1.EQ.IY2).AND.(IY1.EQ.IY2-11).AND.(IDOT(IX4,IY4+1).EQ.1))
     1 IX2=IX2+1
  143 IF (IY3.EQ.9)GO TO 145
      IF ((IX2.EQ.IY2).AND.(IY1.EQ.IY2+9).AND.(IDOT(IX3,IY3+1).EQ.1)) 
     1 IX1=IX1+1
  145 CONTINUE
      GO TO 280 
  150 DO 155 M1=I+1,L 
      IY1=IVEC(M1)/100
      IY2=IVEC(M1)-IY1*100
      IF (IX3.EQ.1)GO TO 151
      IF((IX2.EQ.IY1).AND.(IY2.EQ.IY1+11).AND.(IDOT(IX3-1,IY3).EQ.1)) 
     1 IX1=IX1-10 
  151 IF (IX3.EQ.7)GO TO 152
      IF((IX2.EQ.IY1).AND.(IY2.EQ.IY1-9).AND.(IDOT(IX3+1,IY3).EQ.1))
     1 IX1=IX1+10 
  152 IF (IX4.EQ.1)GO TO 153
      IF((IX1.EQ.IY2).AND.(IY1.EQ.IY2+9).AND.(IDOT(IX4-1,IY4).EQ.1))
     1 IX2=IX2-10 
  153 IF (IX4.EQ.7)GO TO 155
      IF ((IX1.EQ.IY2).AND.(IY1.EQ.IY2-11).AND.(IDOT(IX4+1,IY4).EQ.1))
     1 IX2=IX2+10 
  155 CONTINUE
  280 IVEC(I)=IX1*100+IX2 
      DO 180 I=1,L-1
      M=I+1 
      IX1=IVEC(I)/100 
      IX2=IVEC(I)-IX1*100 
      IF((IX2.NE.IX1+11).AND.(IX2.NE.IX1-9))GO TO 180 
      DO 175 M1=M,L 
   69 IY1=IVEC(M1)/100
      IY2=IVEC(M1)-IY1*100
      IF (IX2.NE.IY1)GO TO 175
      IF((IY2.NE.IY1+11).AND.(IY2.NE.IY1-9))GO TO 175 
      IF((IX2.GT.IX1).AND.(IY2.GT.IY1))GO TO 171
      IF((IX2.LT.IX1).AND.(IY2.LT.IY1))GO TO 173
      GO TO 175 
  171 IX2=IY2 
      L=L-1 
      IF (M1.GT.L)GO TO 180 
      DO 172 M2=M1,L
  172 IVEC(M2)=IVEC(M2+1) 
      GO TO 69
  173 IX2=IY2 
      L=L-1 
      IF (L.LT.M1)GO TO 180 
      DO 174 M2=M1,L
  174 IVEC(M2)=IVEC(M2+1) 
      GO TO 69
  175 CONTINUE
  180 IVEC(I)=IX1*100+IX2 
      IF (L.EQ.0) GO TO 91
      DO 90 I=1,L 
      IX1=IVEC(I)/1000
      IY1=IVEC(I)/100-IX1*10
      IX2=IVEC(I)/10-(IX1*100+IY1*10) 
      IY2=IVEC(I)-(IX1*1000+IY1*100+IX2*10) 
      IF (IX1.EQ.IX2)GO TO 75 
      IF (IY1.EQ.IY2)GO TO 80 
      IT=IX1
      DO 71 JT=IY1,IY2
      IDOT(IT,JT)=0 
      IT=IT+1 
      IF (IX1.GT.IX2)IT=IT-2
   71 CONTINUE
      GO TO 85
   75 DO 76 M1=IY1,IY2
   76 IDOT(IX1,M1)=0
      GO TO 85
   80 DO 81 M1=IX1,IX2
   81 IDOT(M1,IY1)=0
   85 CONTINUE
   90 CONTINUE
   91 DO 95 I=1,7 
      DO 95 J=1,9 
      IF (IDOT(I,J).EQ.0)GO TO 95 
      L=L+1 
      IVEC(L)=I*1000+J*100+I*10+J 
   95 CONTINUE
      IF (L.GT.0)GO TO 96 
      JCNT=JCNT+1 
      IBFF(JCNT)=10000
      GO TO 100 
   96 IVEC(1)=IVEC(1)+10000 
      DO 99 I=1,L 
      JCNT=JCNT+1 
   99 IBFF(JCNT)=IVEC(I)
  100 CONTINUE
      NUM=JCNT
      RETURN
      END 
C 
C 
C 
      SUBROUTINE Z12FN(LU,RBACK)
      INTEGER RBACK 
      RBACK=6 
      IF (LU.NE.0) GO TO 30 
      RETURN
   30 IDRT=IGET(1652B)
      LUMAX=IGET(1653B) 
      IF (LUMAX .GT. 63) LUMAX = 63                                     DS2040
      IF (LU.GT.LUMAX)RETURN
      IPNT=IDRT+(LU-1)
      IEQT=IAND(IGET(IPNT),77B) 
      DO 100 I=1,LUMAX
      RBACK=I 
      IPNT=IDRT+(I-1) 
      JEQT=IAND(IGET(IPNT),77B) 
      IF(IEQT.NE.JEQT)GO TO 100 
      JSC=IAND(IGET(IPNT),174000B)/2048 
      IF(JSC.EQ.3)RETURN
  100 CONTINUE
      RBACK=LU
      RETURN
      END 
      END$
                                                                                                        