Nbody6
status.f
Go to the documentation of this file.
1  SUBROUTINE status(X,I1,I2,I3,I4)
2 *
3 *
4 * Current configuration.
5 * ----------------------
6 *
7  IMPLICIT REAL*8 (a-h,o-z)
8  REAL*8 x(12),rr(6)
9  INTEGER ii(4,4),in(6),jn(6),ij(6)
10  LOGICAL switch
11  common/ind6/ ind(6)
12  common/config/ r2(4,4),j1,j2,j3,j4
13  DATA ii/0,3,2,2,4,0,1,1,4,4,0,1,3,3,2,0/
14 *
15 *
16 * Form mutual square distances and determine closest pair indices.
17  r2min = 1.0d+10
18  l = 0
19  DO 10 i = 1,3
20  DO 5 j = i+1,4
21  il = 3*(i - 1)
22  jl = 3*(j - 1)
23  r2(i,j) = (x(il+1) - x(jl+1))**2 + (x(il+2) - x(jl+2))**2
24  & + (x(il+3) - x(jl+3))**2
25  r2(j,i) = r2(i,j)
26  l = l + 1
27  rr(l) = r2(i,j)
28  in(l) = i
29  jn(l) = j
30  IF (r2(i,j).LT.r2min) THEN
31  r2min = r2(i,j)
32 * Set closest pair indices in J1 & J2.
33  j1 = i
34  j2 = j
35  END IF
36  5 CONTINUE
37  10 CONTINUE
38 *
39 * Set indices of the two distant particles.
40  j3 = ii(j1,j2)
41  j4 = ii(j2,j1)
42 * Ensure that body #J3 is closest to #J1 & J2.
43  IF (r2(j1,j3) + r2(j2,j3).GT.r2(j1,j4) + r2(j2,j4)) THEN
44  jdum = j3
45  j3 = j4
46  j4 = jdum
47  END IF
48 *
49 * Sort square distances.
50  CALL rsort(rr,switch,ind)
51  DO 20 k = 3,5
52  ij(1) = in(ind(1))
53  ij(2) = jn(ind(1))
54  ij(3) = in(ind(2))
55  ij(4) = jn(ind(2))
56  ij(5) = in(ind(k))
57  ij(6) = jn(ind(k))
58 * Form particle chain for regularization.
59  CALL ichain(ij,ko,i1,i2,i3,i4)
60  IF (ko.EQ.1) go to 30
61  20 CONTINUE
62 *
63  30 RETURN
64 *
65  END