Nbody6
bodies.f
Go to the documentation of this file.
1  SUBROUTINE bodies
2 *
3 *
4 * Output of single bodies or binaries.
5 * ------------------------------------
6 *
7  include 'common6.h'
8  REAL*8 a(3)
9 *
10 *
11 * Check option for printing single bodies.
12  IF (kz(9).EQ.0) go to 20
13  k = kz(9)
14  ibody = min(5**k,ntot)
15 *
16  DO 10 i = 1,ibody
17  firr = sqrt(fi(1,i)**2 + fi(2,i)**2 + fi(3,i)**2)
18  freg = sqrt(fr(1,i)**2 + fr(2,i)**2 + fr(3,i)**2)
19  ei = 0.5*(xdot(1,i)**2 + xdot(2,i)**2 + xdot(3,i)**2)
20  DO 4 j = 1,n
21  IF (j.EQ.i) go to 4
22  IF (i.GT.n.AND.j.LT.ifirst) go to 4
23  rij2 = (x(1,i) - x(1,j))**2 + (x(2,i) - x(2,j))**2 +
24  & (x(3,i) - x(3,j))**2
25  ei = ei - body(j)/sqrt(rij2)
26  4 CONTINUE
27  IF (kz(14).GT.0) THEN
28  CALL xtrnlv(i,i)
29  ei = ei + ht
30  END IF
31  DO 5 k = 1,3
32  a(k) = x(k,i) - rdens(k)
33  5 CONTINUE
34  ri = sqrt(a(1)**2 + a(2)**2 + a(3)**2)
35  WRITE (6,6) i, name(i), body(i), step(i), stepr(i), ei, ri,
36  & list(1,i), (a(k),k=1,3), (xdot(k,i),k=1,3), firr,
37  & freg, rs(i)
38  6 FORMAT (i6,i5,2f8.4,f7.3,f7.1,f7.2,i6,3x,3f7.2,3x,3f6.2,3x,
39  & f7.1,f6.1,f7.2)
40  10 CONTINUE
41 *
42 * Optional search for soft binaries (frequency NFIX with KZ(6) = 4).
43  20 IF (kz(6).EQ.0) go to 70
44  IF (kz(6).EQ.2) go to 50
45  IF (kz(6).EQ.4.AND.nprint.NE.1) go to 50
46  simax = 0.01*tcr
47 *
48  DO 40 i = ifirst,ntot
49  IF (step(i).GT.simax) go to 40
50  jmin = 0
51  rjmin2 = rscale**2
52  nnb = list(1,i)
53  DO 30 l = 1,nnb
54  j = list(l+1,i)
55  IF (step(j).GT.simax) go to 30
56  a1 = x(1,i) - x(1,j)
57  a2 = x(2,i) - x(2,j)
58  a3 = x(3,i) - x(3,j)
59  rij2 = a1**2 + a2**2 + a3**2
60  IF (rij2.LT.rjmin2) THEN
61  rjmin2 = rij2
62  jmin = j
63  END IF
64  30 CONTINUE
65  IF (jmin.LE.i) go to 40
66  rijmin = sqrt(rjmin2)
67  vr2 = (xdot(1,i) - xdot(1,jmin))**2 +
68  & (xdot(2,i) - xdot(2,jmin))**2 +
69  & (xdot(3,i) - xdot(3,jmin))**2
70  erel = 0.5*vr2 - (body(i) + body(jmin))/rijmin
71 * Only print significant binaries.
72  IF (erel.GT.-0.1*eclose) go to 40
73  semi = -0.5*(body(i) + body(jmin))/erel
74  zn = sqrt((body(i) + body(jmin))/semi**3)
75  rdot = (x(1,i) - x(1,jmin))*(xdot(1,i) - xdot(1,jmin)) +
76  & (x(2,i) - x(2,jmin))*(xdot(2,i) - xdot(2,jmin)) +
77  & (x(3,i) - x(3,jmin))*(xdot(3,i) - xdot(3,jmin))
78  ecc2 = (1.0 - rijmin/semi)**2 +
79  & rdot**2/(semi*(body(i) + body(jmin)))
80  ecc = sqrt(ecc2)
81  ri = sqrt((x(1,i) - rdens(1))**2 + (x(2,i) - rdens(2))**2 +
82  & (x(3,i) - rdens(3))**2)
83  WRITE (6,35) name(i), name(jmin), body(i), body(jmin), erel,
84  & semi, zn, rijmin, ri, ecc, list(1,i)
85  35 FORMAT (' BINARY ',2i5,2f8.4,f9.1,1p,4e10.2,0p,f7.2,2i5,
86  & 1p,e10.1,0p,f7.2,i4)
87  40 CONTINUE
88 *
89 * Output of regularized binaries (frequency NFIX with KZ(6) = 4).
90  50 DO 60 jpair = 1,npairs
91  IF (h(jpair).GE.0.0) go to 60
92  i = 2*jpair - 1
93  icm = n + jpair
94  jmin = i + 1
95  IF (body(i).LE.0.0d0) go to 60
96  semi = -0.5*(body(i) + body(jmin))/h(jpair)
97  zn = sqrt((body(i) + body(jmin))/semi**3)
98  rp = u(1,jpair)**2 + u(2,jpair)**2 + u(3,jpair)**2 +
99  & u(4,jpair)**2
100  ecc2 = (1.0 - rp/semi)**2 +
101  & tdot2(jpair)**2/(semi*(body(i) + body(jmin)))
102  ecc = sqrt(ecc2)
103  ri = sqrt((x(1,icm) - rdens(1))**2 +
104  & (x(2,icm) - rdens(2))**2 +
105  & (x(3,icm) - rdens(3))**2)
106  vi = sqrt(xdot(1,icm)**2 + xdot(2,icm)**2 + xdot(3,icm)**2)
107  WRITE (6,35) name(i), name(jmin), body(i), body(jmin),
108  & h(jpair), semi, zn, rp, ri, ecc, list(1,i),
109  & list(1,n+jpair), gamma(jpair), vi, kslow(jpair)
110  60 CONTINUE
111 *
112  70 RETURN
113 *
114  END