Nbody6
 All Files Functions Variables
remove.f
Go to the documentation of this file.
1  SUBROUTINE remove(I,KCASE)
2 *
3 *
4 * Particle removal.
5 * -----------------
6 *
7  include 'common6.h'
8  REAL*8 a(6)
9 *
10 *
11 * Remove escaper, KS pair, components or c.m. (KCASE = 1, 2, 3).
12  IF (kcase.EQ.2) go to 20
13  IF (kcase.EQ.3) go to 10
14 *
15 * Correct force & first derivative of neighbours (only for escape).
16  nnb1 = list(1,i) + 1
17  DO 5 l = 2,nnb1
18  j = list(l,i)
19  rij2 = 0.0d0
20  a7 = 0.0d0
21  DO 1 k = 1,3
22  a(k) = x(k,i) - x(k,j)
23  a(k+3) = xdot(k,i) - xdot(k,j)
24  rij2 = rij2 + a(k)**2
25  a7 = a7 + a(k)*a(k+3)
26  1 CONTINUE
27  a8 = body(i)/(rij2*sqrt(rij2))
28  DO 2 k = 1,3
29  a(k+3) = (a(k+3) - 3.0*a7*a(k)/rij2)*a8
30  f(k,j) = f(k,j) - 0.5*a(k)*a8
31  fi(k,j) = fi(k,j) - a(k)*a8
32  fdot(k,j) = fdot(k,j) - one6*a(k+3)
33  d1(k,j) = d1(k,j) - a(k+3)
34  2 CONTINUE
35  5 CONTINUE
36 *
37 * Move up all COMMON variables (escaper or old c.m. & KS comps).
38  10 IF (i.GT.ntot) go to 50
39 *
40  DO 15 j = i,ntot
41  j1 = j + 1
42  DO 12 k = 1,3
43  x(k,j) = x(k,j1)
44  x0(k,j) = x0(k,j1)
45  x0dot(k,j) = x0dot(k,j1)
46  xdot(k,j) = xdot(k,j1)
47  f(k,j) = f(k,j1)
48  fdot(k,j) = fdot(k,j1)
49  fi(k,j) = fi(k,j1)
50  fidot(k,j) = fidot(k,j1)
51  d0(k,j) = d0(k,j1)
52  d1(k,j) = d1(k,j1)
53  d2(k,j) = d2(k,j1)
54  d3(k,j) = d3(k,j1)
55  fr(k,j) = fr(k,j1)
56  frdot(k,j) = frdot(k,j1)
57  d0r(k,j) = d0r(k,j1)
58  d1r(k,j) = d1r(k,j1)
59  d2r(k,j) = d2r(k,j1)
60  d3r(k,j) = d3r(k,j1)
61  12 CONTINUE
62 *
63  body(j) = body(j1)
64  rs(j) = rs(j1)
65  radius(j) = radius(j1)
66  tev(j) = tev(j1)
67  tev0(j) = tev0(j1)
68  body0(j) = body0(j1)
69  epoch(j) = epoch(j1)
70  spin(j) = spin(j1)
71  zlmsty(j) = zlmsty(j1)
72  kstar(j) = kstar(j1)
73  name(j) = name(j1)
74  step(j) = step(j1)
75  stepr(j) = stepr(j1)
76  t0(j) = t0(j1)
77  t0r(j) = t0r(j1)
78 *
79 * Transfer unmodified neighbour list.
80  nnb = list(1,j1) + 1
81 * Include flag of 2nd component (note new IFIRST if escaping pair).
82  IF (j.LE.ifirst.AND.nnb.EQ.1) nnb = 2
83  DO 14 l = 1,nnb
84  list(l,j) = list(l,j1)
85  14 CONTINUE
86  15 CONTINUE
87 *
88  go to 50
89 *
90 * Move up all tables of KS pairs below IPAIR = I.
91  20 DO 30 jpair = i,npairs
92  jp1 = jpair + 1
93  DO 25 k = 1,4
94  u(k,jpair) = u(k,jp1)
95  u0(k,jpair) = u0(k,jp1)
96  udot(k,jpair) = udot(k,jp1)
97  fu(k,jpair) = fu(k,jp1)
98  fudot(k,jpair) = fudot(k,jp1)
99  fudot2(k,jpair) = fudot2(k,jp1)
100  fudot3(k,jpair) = fudot3(k,jp1)
101  sf(k,jpair) = sf(k,jp1)
102  fp0(k,jpair) = fp0(k,jp1)
103  fd0(k,jpair) = fd0(k,jp1)
104  25 CONTINUE
105 *
106  r(jpair) = r(jp1)
107  r0(jpair) = r0(jp1)
108  dtau(jpair) = dtau(jp1)
109  tdot2(jpair) = tdot2(jp1)
110  tdot3(jpair) = tdot3(jp1)
111  gamma(jpair) = gamma(jp1)
112  h(jpair) = h(jp1)
113  hdot(jpair) = hdot(jp1)
114  hdot2(jpair) = hdot2(jp1)
115  hdot3(jpair) = hdot3(jp1)
116  hdot4(jpair) = hdot4(jp1)
117  kslow(jpair) = kslow(jp1)
118  sf(5,jpair) = sf(5,jp1)
119  sf(6,jpair) = sf(6,jp1)
120  sf(7,jpair) = sf(7,jp1)
121  h0(jpair) = h0(jp1)
122  30 CONTINUE
123 *
124  50 RETURN
125 *
126  END