INDSHF=IIII(ISYMA)
      NBFA=NBFT(ISYMA)
      ISM =NZBF(ISYMA)
      ISYMAK=ISYMA
      READ(ITAPE)IBX
      allocate (vv(lenb))
      IF(ITYP.LT.0) GO TO 450
      IJ2=0
      DO 411 I=1,NBFA
      INDI=I*(I-1)/2
      IX=I+ISM
      INDIX=IX*(IX-1)/2+ISM
      DO 412 J=1,I
      IJ=INDIX+J
      IJF=INDI+J
      IJ2=IJ2+1
      IF(IJX.NE.IJ2) GO TO 412
      KL2=0
      CALL INTAPE(VV,LENB,ITAPE)
c
      IN=1
      KLX=imask(VV(IN))
      IF(IFULLI.NE.0) KLX=1
      VAL=VV(IN)
      INDJ=J*(J-1)/2
      DO 413 K=1,I
      INDIK=INDI+K
      INDK=K*(K-1)/2
      KX=K+ISM
      INDKX=KX*(KX-1)/2+ISM
      IF(J.ge.K) then
        INDJK=INDJ+K
      else
        INDJK=INDK+J
      endif
      LEND=K
      IF(I.EQ.K) LEND=J
      DO 414 L=1,LEND
      KL=INDKX+L
      KL2=KL2+1
      IF(KL2.NE.KLX) GO TO 414
      IF(ABS(VAL).LT.THRESH .AND. IFULLO .EQ. 0) GO TO 98
      VAA=VAL*4.0
      IF(IJ.EQ.KL) VAA=VAA*0.5d0
      IJBUF=IJBUF+1
      IF (IFULLO .EQ. 0) THEN
        BUF(IJBUF)=jmask(VAA,KL)
      ELSE
        BUF(IJBUF) = VAA
      ENDIF
      INDIL=INDI+L
      IF(J.ge.L) then
        INDJL=INDJ+L
      else
        INDJL=L*(L-1)/2+J
      endif
      IF(INDJK.le.INDIL) then
        INDEX1=INDIL*(INDIL-1)/2+INDJK+INDSHF
      else
        INDEX1=INDJK*(INDJK-1)/2+INDIL+INDSHF
      endif
      IF(INDJL.le.INDIK) then
        INDEX2=INDIK*(INDIK-1)/2+INDJL+INDSHF
      else
        INDEX2=INDJL*(INDJL-1)/2+INDIK+INDSHF
      endif
      IF(INCOR.EQ.0) GO TO 200
      IF(I.EQ.J.OR.K.EQ.L) GO TO 250
      IF(I.ne.L.and.J.ne.K) then
        A(INDEX1)=VAL+A(INDEX1)
      else
        A(INDEX1)=VAL*2.d0+A(INDEX1)
      endif
250   CONTINUE
      IF(I.EQ.K.OR.J.EQ.L) VAL=VAL*2.d0
      A(INDEX2)=VAL+A(INDEX2)
      GO TO 98
200   CONTINUE
      IBIN1=(INDEX1-1)/NBINFD+1
      IBIN2=(INDEX2-1)/NBINFD+1
      IF(I.EQ.J.OR.K.EQ.L) GO TO 8002
      IW1=IBIN(1,IBIN1)
      IPUTX=IW1+3
      IPUTI=IPUTX+INTSPB
      IF(I.EQ.L.OR.J.EQ.K) then
        BIN(IPUTX,IBIN1)=VAL*2.d0
      else
        BIN(IPUTX,IBIN1)=VAL
      endif
      IBIN(IPUTI,IBIN1)=INDEX1
      IW1=IW1+1
      IBIN(1,IBIN1)=IW1
      IF(IW1.eq.INTSPB) then
        CALL OUTAPD(BIN(1,IBIN1),NWRDPB,ISCR,LX)
        IBIN(2,IBIN1)=LX
        IBIN(1,IBIN1)=0
      endif
8002  CONTINUE
      IF(I.EQ.K.OR.J.EQ.L) VAL=VAL*2.d0
      IW2=IBIN(1,IBIN2)
      IPUTX=IW2+3
      IPUTI=IPUTX+INTSPB
      BIN(IPUTX,IBIN2)=VAL
      IBIN(IPUTI,IBIN2)=INDEX2
      IW2=IW2+1
      IBIN(1,IBIN2)=IW2
      IF(IW2.eq.INTSPB) then
        CALL OUTAPD(BIN(1,IBIN2),NWRDPB,ISCR,LX)
        IBIN(2,IBIN2)=LX
        IBIN(1,IBIN2)=0
      endif
c
98    IN=IN+1
      IF(IN.GT.LENB) GO TO 415
      VAL=VV(IN)
      KLX=imask(VV(IN))
      IF(IFULLI.NE.0) KLX=KL2+1
      IF(KLX.GT.IJ2) GO TO 415
414   CONTINUE
413   CONTINUE
415   CONTINUE
c
      IF (IFULLO .EQ. 0) THEN
        CALL FILB(BUF,IJBUF,IJ,IPUNIT,ISYMAK,ISYMAK)
      ELSE
        CALL FILB(BUF,IJBUF,IJF,IPUNIT,ISYMAK,ISYMAK)
      ENDIF
      IF (IPFLG .EQ. 2) THEN
        IF (IFULLO .EQ. 0) THEN
          CALL PRINTR(IJ,IJBUF,BUF)
        ELSE
          CALL PRINTS(IJF,IJBUF,BUF,ISYMAK,ISYMAK)
        ENDIF
      ENDIF
      READ(ITAPE)IBX
      IJBUF=0
      IF(ITYP.LT.0) GO TO 450
412   CONTINUE
411   CONTINUE
C
      GO TO 450