Nbody6
 All Files Functions Variables
tstab.f
Go to the documentation of this file.
1  SUBROUTINE tstab(I,ECC1,SEMI1,PMIN1,YFAC,ITERM)
2 *
3 *
4 * Hierarchical stability time.
5 * ----------------------------
6 *
7  include 'common6.h'
8  common/binary/ cm(4,mmax),xrel(3,mmax),vrel(3,mmax),
9  & hm(mmax),um(4,mmax),umdot(4,mmax),tmdis(mmax),
10  & namem(mmax),nameg(mmax),kstarm(mmax),iflagm(mmax)
11 *
12 *
13 * Distinguish between absolute and approximate stability.
14  iterm = 0
15  IF (pmin1.GT.yfac*pcrit.OR.kz(19).EQ.0.OR.kz(27).EQ.0) THEN
16  tmdis(nmerge+1) = 1.0d+10
17  ELSE IF (name(i).LT.0.OR.name(jcomp).LT.0) THEN
18 * Skip double hierarchy (RESET2 uses standard stability criterion).
19  iterm = 1
20  ELSE IF (pmin1.GT.0.8*yfac*pcrit.OR.
21  & (ecc1.GT.0.99.AND.ecc1.LT.1.0)) THEN
22 * Estimate time-scale for long-lived hierarchy.
23  nk = 1 + 10.0*ecc1/(1.0 - ecc1)
24 * Define termination time in terms of outer periods.
25  tk = twopi*semi1*sqrt(abs(semi1)/(body(i) + body(jcomp)))
26 * Set disruption time in new merger location for routine KSINT.
27  tmdis(nmerge+1) = time + abs(nk*tk)
28 * WRITE (6,3) YFAC,PMIN1,PCRIT,0.8*YFAC*PCRIT,NK*TK
29 * 3 FORMAT (' TSTAB: YFAC PMIN1 PCR PTEST N*TK ',F6.2,1P,4E9.2)
30 * Note that large NK implies termination by other means.
31  IF (ecc1.LT.1.0.AND.nk.LE.1) iterm = 1
32 * Modify PCRIT so it becomes < SEMI1*(1 - ECC1)*(1 - 2*PERT).
33  IF (pcrit.LT.pmin1) pcrit = 0.999*pmin1/yfac
34  ELSE IF (ecc1.LT.1.0) THEN
35 * Specify termination in all other cases (but allow hyperbolic orbit).
36  iterm = 1
37  END IF
38 *
39  RETURN
40 *
41  END