Nbody6
ksapo.f
Go to the documentation of this file.
1  SUBROUTINE ksapo(IPAIR)
2 *
3 *
4 * Apocentre/pericentre/random KS variables.
5 * -----------------------------------------
6 *
7  include 'common6.h'
8  REAL*8 ran2
9 *
10 *
11 * Specify half regularized period (PI/2) or random phase (unperturbed).
12  IF (ipair.GT.0) THEN
13  theta = 0.25d0*twopi
14  ikick = 0
15  ELSE
16  theta = 0.5*twopi*ran2(idum1)
17  ipair = -ipair
18 * Note new type not known here but WD case kick decided by option #25.
19  ikick = 1
20  IF (list(1,2*ipair-1).GT.0) theta = 0.0d0
21 * Initialize time because HDOT & TDOT2 not updated for RESOLV.
22  t0(2*ipair-1) = time
23 * Skip hyperbolic orbit (i.e. kick for second binary component).
24  IF (h(ipair).GT.0.0) go to 30
25  END IF
26 *
27 * Form transformation coefficients (Stiefel & Scheifele p. 85).
28  xc = cos(theta)
29  ys = sin(theta)
30  ff = sqrt(0.5d0*abs(h(ipair)))
31  r(ipair) = 0.0d0
32  tdot2(ipair) = 0.0d0
33 *
34 * Generate analytical solutions for U & UDOT using old U0 & UDOT.
35  DO 10 k = 1,4
36  u(k,ipair) = u0(k,ipair)*xc + udot(k,ipair)*ys/ff
37  udot(k,ipair) = udot(k,ipair)*xc - u0(k,ipair)*ys*ff
38  u0(k,ipair) = u(k,ipair)
39  r(ipair) = r(ipair) + u(k,ipair)**2
40  tdot2(ipair) = tdot2(ipair) + 2.0d0*u(k,ipair)*udot(k,ipair)
41  10 CONTINUE
42 *
43 * Impose R' < 0 for apocentre procedures (IKICK = 0).
44  semi = -0.5d0*body(n+ipair)/h(ipair)
45  IF (tdot2(ipair).GT.0.0d0.AND.r(ipair).GT.semi) THEN
46  IF (ikick.EQ.0) THEN
47  tdot2(ipair) = -1.0e-20
48  END IF
49  END IF
50 *
51 * Include diagnostic check that correct apocentre has been set.
52 * SEMI = -0.5D0*BODY(N+IPAIR)/H(IPAIR)
53 * WRITE (6,20) SEMI, R(IPAIR), H(IPAIR), GAMMA(IPAIR)
54 * 20 FORMAT (' APOCENTRE: A RA H G ',1P,2E10.2,2E10.1)
55 *
56 * Save KS parameters for WD or neutron star kick (routine FCORR).
57  30 IF (ikick.GT.0) THEN
58  CALL kick(ipair,0,0,0.0d0)
59  END IF
60 *
61  RETURN
62 *
63  END