Nbody6
 All Files Functions Variables
tail0.f
Go to the documentation of this file.
1  SUBROUTINE tail0(I)
2 *
3 *
4 * Initialization of tidal tail member.
5 * ------------------------------------
6 *
7  include 'common6.h'
8  common/galaxy/ gmg,rg(3),vg(3),fg(3),fgd(3),tg,
9  & omega,disk,a,b,v02,rl2,gmb,ar,gam,zdum(7)
10  REAL*8 xi(3),xidot(3),firr(3),fd(3)
11  SAVE iwarn
12  DATA iwarn /0/
13 *
14 *
15 * Transform to galactic coordinates.
16  DO 5 k = 1,3
17  xi(k) = x(k,i) + rg(k)
18  xidot(k) = xdot(k,i) + vg(k)
19  firr(k) = 0.0
20  fd(k) = 0.0
21  5 CONTINUE
22 *
23 * Obtain relevant force components.
24  CALL xtrnlt(xi,xidot,firr,fd)
25 *
26 * Update membership (first member in NTTOT = ITAIL0).
27  IF (ntail.EQ.0) THEN
28  nstail = 0
29 * Allow extra space for ten KS solutions.
30  itail0 = nzero + min(kmax,nbin0+10)
31  nttot = itail0 - 1
32  END IF
33 *
34 * Include safety test and 10 warnings for maximum membership.
35  IF (nttot.GE.nmax) THEN
36  iwarn = iwarn + 1
37  IF (iwarn.LE.10) THEN
38  WRITE (6,10) nttot
39  10 FORMAT (' WARNING! MAXIMUM TIDAL TAIL ',i6)
40  END IF
41  RETURN
42  END IF
43 *
44 * Increase the memberships (note initial value ITAIL0 - 1).
45  nttot = nttot + 1
46  ntail = ntail + 1
47  j = nttot
48 *
49 * Copy escaper data and initialize integration variables.
50  name(j) = name(i)
51  body(j) = body(i)
52  ff = 0.0
53  ffd = 0.0
54  DO 20 k = 1,3
55  x(k,j) = xi(k)
56  x0(k,j) = xi(k)
57  xdot(k,j) = xidot(k)
58  x0dot(k,j) = xidot(k)
59  f(k,j) = 0.5*firr(k)
60  fdot(k,j) = one6*fd(k)
61  fi(k,j) = firr(k)
62  fidot(k,j) = fd(k)
63  ff = ff + firr(k)**2
64  ffd = ffd + fd(k)**2
65  20 CONTINUE
66 *
67 * Form quantized time-step (saves prediction at nice output times).
68  dt = 0.5*etai*sqrt(ff/ffd)
69  CALL stepk(dt,dtn)
70  step(j) = dtn
71  t0(j) = time
72  tnew(j) = t0(j) + step(j)
73 *
74  RETURN
75 *
76  END