FTN4,L
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C     SOURCE PART NUMBER :92067-18380 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACAST    ALTERS SST FOR EITER GROUP 
C              OR USER SST
C 
C              INPUT SST'S START IN LDCB(15)
C              NUMBER OF CHANGES ARE IN LDCB(14)
C 
C     CALLING SEQUENCE: 
C       CALL ACAST(JBUF(33))        FOR USER
C       CALL ACAST(NBUF(6+IOFST))   FOR GROUP 
C 
      SUBROUTINE ACAST(JBUF)  ,92067-16361 REV.1940 781024  
      DIMENSION JBUF(64)
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      KEND=LDCB(14) 
      JEND=JBUF(1)
      IF(JEND.LT.0) JEND=-JEND-1
C 
C     LOOP FOR ALL CHANGES
C 
      IF(KEND.LT.15) GO TO 700
      DO 600 K=15,KEND
      IF(JEND.LE.0) GO TO 200 
C 
C     SEARCH FOR MATCH
C 
      DO 100 J=2,JEND+1 
      IF(IAND(LDCB(K),77B).EQ.IAND(JBUF(J),77B)) GO TO 300
  100 CONTINUE
C 
C     NO MATCH
C 
  200 IF(IAND(LDCB(K),128).EQ.128) GO TO 600
C 
C     ADD ENTRY 
C 
      JEND=JEND+1 
      JBUF(JEND+1)=LDCB(K)
      GO TO 600 
C 
C     FOUND MATCH 
C 
  300 IF(IAND(LDCB(K),128).NE.128) GO TO 500
C 
C     DELETE ENTRY
C 
      DO 400 JJ=J,JEND
  400 JBUF(JJ)=JBUF(JJ+1) 
      JEND=JEND-1 
      GO TO 600 
  500 JBUF(J)=LDCB(K) 
  600 CONTINUE
C 
C     FIX JBUF(1) 
C 
  700 IF(JBUF(1).LT.0) JEND=-JEND 
      JBUF(1)=JEND
      RETURN
      END 
                                                                                                                                                                                          