*
*       Modify the list of previously regularized binaries.
      NNB = LISTR(1) - 1
      L = 0
   91 L = L + 2
   92 IF (L.GT.NNB + 1) GO TO 96
      J = LISTR(L)
      K = LISTR(L+1)
*       First check the current two-body separation of any old pairs.
      RJK2 = (X(1,J) - X(1,K))**2 + (X(2,J) - X(2,K))**2 +
     &                              (X(3,J) - X(3,K))**2
*       Remove pair if RJK > 4*RMIN when special procedure not needed.
      IF (RJK2.LT.16.0*RMIN**2) GO TO 91
      DO 94 K = L,NNB
          LISTR(K) = LISTR(K+2)
   94 CONTINUE
      NNB = NNB - 2
      GO TO 92
*
*       Add ICOMP & JCOMP to LISTR (maximum of MLR/2 - 1 pairs).
   96 IF (NNB.GT.MLR - 4) THEN
*       Note that NNB is one less than the actual membership.
          DO 98 K = 2,NNB
              LISTR(K) = LISTR(K+2)
   98     CONTINUE
          NNB = NNB - 2
*       Removal of the oldest KS pair.
      END IF
      LISTR(NNB+3) = ICOMP
      LISTR(NNB+4) = JCOMP
      LISTR(1) = NNB + 3
*
*       Copy flag index of disrupted pair (set in KSTERM).
      IFLAG = JLIST(3)
*       Add primordial pairs to LISTD (skip new KS pairs or primordials).
      IF (IFLAG.EQ.0.OR.IABS(JLIST(1) - JLIST(2)).EQ.1) GO TO 110
*
*       Check list of disrupted component names.
      NNB = LISTD(1) - 1
      KCOMP = 0
      DO 100 K = 2,NNB+1,2
          IF (LISTD(K).EQ.JLIST(1).AND.LISTD(K+1).EQ.JLIST(2)) KCOMP = 1
  100 CONTINUE
*
*       Include both components unless already members.
      IF (KCOMP.EQ.0) THEN
          IF (NNB.GT.MLD - 4) THEN
              DO 102 K = 2,NNB
                 LISTD(K) = LISTD(K+2)
  102         CONTINUE
              NNB = NNB - 2
          END IF
*       Add most recent names at the end (limit is MLD/2 - 1 pairs).
          LISTD(NNB+3) = JLIST(1)
          LISTD(NNB+4) = JLIST(2)
          LISTD(1) = NNB + 3
      END IF
      IF (IFLAG.NE.-1) WRITE (8,104)  IPAIR, IFLAG, JLIST(1), JLIST(2)
  104 FORMAT (' LISTD INCONSISTENCY!!  IPAIR IFLAG NAMES ',2I5,2I8)
*
*       Update list of high velocity particles containing c.m. members.
  110 NNB = LISTV(1)
      DO 130 L = 2,NNB+1
          IF (LISTV(L).EQ.ICM) THEN
*       Remove old c.m. and reduce the membership.
              DO 125 K = L,NNB
                  LISTV(K) = LISTV(K+1)
  125         CONTINUE
              LISTV(1) = LISTV(1) - 1
          END IF
*       Reduce higher particle locations by one.
          IF (LISTV(L).GT.ICM) THEN
              LISTV(L) = LISTV(L) - 1
          END IF
  130 CONTINUE
*