Nbody6
insert.f
Go to the documentation of this file.
1  SUBROUTINE insert(I,LI)
2 *
3 *
4 * Insert particle index in KS time-step list.
5 * -------------------------------------------
6 *
7  include 'common6.h'
8  REAL*8 ti,ti1,ti2,tj
9 *
10 *
11 * Avoid increasing KBLIST if body #I can be exchanged with next member.
12  li2 = min(li + 2,nntb)
13  i2 = kblist(li2)
14  ti = t0(i) + step(i)
15  ti2 = t0(i2) + step(i2)
16 *
17 * Check swapping condition (#I due before #I2 but after #I1 at LI + 1).
18  IF (ti.LE.ti2) THEN
19  li1 = min(li+1,nntb)
20  i1 = kblist(li1)
21  ti1 = t0(i1) + step(i1)
22  IF (ti.GT.ti1) THEN
23  kblist(li) = kblist(li1)
24  kblist(li1) = i
25  END IF
26 * Reduce pointer so that current location will be selected again.
27  li = li - 1
28  go to 50
29 * Also swap if body #I is among the two last members and TI > TI2.
30  ELSE IF (li.GT.nntb - 2) THEN
31  kblist(li) = kblist(li2)
32  kblist(li2) = i
33  li = li - 1
34  go to 50
35  END IF
36 *
37 * Estimate the insert index from the remaining time interval.
38  fac = step(i)/(tblist - time)
39  lstar = li + float(nntb - li)*fac
40 *
41 * Improve insert index by another iteration (check LI < LSTAR <= NNTB).
42  j = kblist(lstar)
43  tj = t0(j) + step(j)
44 * Avoid division by zero (unperturbed steps may also be quantized).
45  IF (tblist.NE.tj) THEN
46  fac = (ti - tj)/(tblist - tj)
47  lstar = lstar + float(nntb - lstar)*fac
48  lstar = max(lstar,li+1)
49  lstar = min(lstar,nntb)
50  j = kblist(lstar)
51  END IF
52 *
53 * Determine correct index by comparing neighbouring KBLIST members.
54  IF (ti.GE.t0(j) + step(j)) THEN
55  l1 = lstar + 1
56  lstar = l1
57  DO 10 l = l1,nntb
58  j = kblist(l)
59  tj = t0(j) + step(j)
60 * Advance index until TI < TJ or last member.
61  IF (ti.LT.tj) go to 30
62  lstar = l + 1
63  10 CONTINUE
64  ELSE
65  20 lstar = lstar - 1
66  j = kblist(lstar)
67  IF (j.EQ.i) THEN
68  li = li - 1
69  go to 50
70  END IF
71  IF (ti.LT.t0(j) + step(j)) go to 20
72  lstar = lstar + 1
73 * Ensure that current index LI is not chosen due to round-off.
74  lstar = max(lstar,li+1)
75  END IF
76 *
77 * Create free location at LSTAR by moving all subsequent members down.
78  30 DO 40 l = nntb,lstar,-1
79  kblist(l+1) = kblist(l)
80  40 CONTINUE
81 *
82 * Insert body #I and update memberships.
83  kblist(lstar) = i
84  nntb = nntb + 1
85 *
86  50 RETURN
87 *
88  END