SUBROUTINE REMOVE(I,KCASE)
*
*
*       Particle removal.
*       -----------------
*
      INCLUDE 'common6.h'
      REAL*8  A(6)
*
*
*       Remove escaper, KS pair, components or c.m. (KCASE = 1, 2, 3).
      IF (KCASE.EQ.2) GO TO 20
      IF (KCASE.EQ.3) GO TO 10
*
*       Correct force & first derivative of neighbours (only for escape).
      NNB1 = LIST(1,I) + 1
      DO 5 L = 2,NNB1
          J = LIST(L,I)
          RIJ2 = 0.0D0
          A7 = 0.0D0
          DO 1 K = 1,3
              A(K) = X(K,I) - X(K,J)
              A(K+3) = XDOT(K,I) - XDOT(K,J)
              RIJ2 = RIJ2 + A(K)**2
              A7 = A7 + A(K)*A(K+3)
    1     CONTINUE
          A8 = BODY(I)/(RIJ2*SQRT(RIJ2))
          DO 2 K = 1,3
              A(K+3) = (A(K+3) - 3.0*A7*A(K)/RIJ2)*A8
              F(K,J) = F(K,J) - 0.5*A(K)*A8
              FI(K,J) = FI(K,J) - A(K)*A8
              FDOT(K,J) = FDOT(K,J) - ONE6*A(K+3)
              D1(K,J) = D1(K,J) - A(K+3)
    2     CONTINUE
    5 CONTINUE
*
*       Move up all COMMON variables (escaper or old c.m. & KS comps).
   10 IF (I.GT.NTOT) GO TO 50
*
      DO 15 J = I,NTOT
          J1 = J + 1
          DO 12 K = 1,3
              X(K,J) = X(K,J1)
              X0(K,J) = X0(K,J1)
              X0DOT(K,J) = X0DOT(K,J1)
              XDOT(K,J) = XDOT(K,J1)
              F(K,J) = F(K,J1)
              FDOT(K,J) = FDOT(K,J1)
              FI(K,J) = FI(K,J1)
              FIDOT(K,J) = FIDOT(K,J1)
              D0(K,J) = D0(K,J1)
              D1(K,J) = D1(K,J1)
              D2(K,J) = D2(K,J1)
              D3(K,J) = D3(K,J1)
              FR(K,J) = FR(K,J1)
              FRDOT(K,J) = FRDOT(K,J1)
              D0R(K,J) = D0R(K,J1)
              D1R(K,J) = D1R(K,J1)
              D2R(K,J) = D2R(K,J1)
              D3R(K,J) = D3R(K,J1)
   12     CONTINUE
*
          BODY(J) = BODY(J1)
          RS(J) = RS(J1)
          RADIUS(J) = RADIUS(J1)
          TEV(J) = TEV(J1)
          TEV0(J) = TEV0(J1)
          BODY0(J) = BODY0(J1)
          EPOCH(J) = EPOCH(J1)
          SPIN(J) = SPIN(J1)
          ZLMSTY(J) = ZLMSTY(J1)
          KSTAR(J) = KSTAR(J1)
          NAME(J) = NAME(J1)
          STEP(J) = STEP(J1)
          STEPR(J) = STEPR(J1)
          T0(J) = T0(J1)
          T0R(J) = T0R(J1)
*
*       Transfer unmodified neighbour list.
          NNB = LIST(1,J1) + 1
*       Include flag of 2nd component (note new IFIRST if escaping pair).
          IF (J.LE.IFIRST.AND.NNB.EQ.1) NNB = 2
          DO 14 L = 1,NNB
              LIST(L,J) = LIST(L,J1)
   14     CONTINUE
   15 CONTINUE
*
      GO TO 50
*
*       Move up all tables of KS pairs below IPAIR = I.
   20 DO 30 JPAIR = I,NPAIRS
          JP1 = JPAIR + 1
          DO 25 K = 1,4
              U(K,JPAIR) = U(K,JP1)
              U0(K,JPAIR) = U0(K,JP1)
              UDOT(K,JPAIR) = UDOT(K,JP1)
              FU(K,JPAIR) = FU(K,JP1)
              FUDOT(K,JPAIR) = FUDOT(K,JP1)
              FUDOT2(K,JPAIR) = FUDOT2(K,JP1)
              FUDOT3(K,JPAIR) = FUDOT3(K,JP1)
              SF(K,JPAIR) = SF(K,JP1)
              FP0(K,JPAIR) = FP0(K,JP1)
              FD0(K,JPAIR) = FD0(K,JP1)
   25     CONTINUE
*
          R(JPAIR) = R(JP1)
          R0(JPAIR) = R0(JP1)
          DTAU(JPAIR) = DTAU(JP1)
          TDOT2(JPAIR) = TDOT2(JP1)
          TDOT3(JPAIR) = TDOT3(JP1)
          GAMMA(JPAIR) = GAMMA(JP1)
          H(JPAIR) = H(JP1)
          HDOT(JPAIR) = HDOT(JP1)
          HDOT2(JPAIR) = HDOT2(JP1)
          HDOT3(JPAIR) = HDOT3(JP1)
          HDOT4(JPAIR) = HDOT4(JP1)
          KSLOW(JPAIR) = KSLOW(JP1)
          SF(5,JPAIR) = SF(5,JP1)
          SF(6,JPAIR) = SF(6,JP1)
          SF(7,JPAIR) = SF(7,JP1)
          H0(JPAIR) = H0(JP1)
   30 CONTINUE
*
   50 RETURN
*
      END