Nbody6
 All Files Functions Variables
endreg.f
Go to the documentation of this file.
1  SUBROUTINE endreg
2 *
3 *
4 * Transformation to physical variables.
5 * -------------------------------------
6 *
7  IMPLICIT REAL*8 (a-h,o-z)
8  REAL*8 m,mij,cm(3)
9  LOGICAL switch,gtype,gtype0
10  common/creg/ m(4),x(12),xd(12),p(12),q(12),time4,energy,epsr2,
11  & xr(9),w(9),r(6),ta(6),mij(6),cmx(10),rmax4,tmax,
12  & ds,tstep,eps,nstep4,name4(4),kz15,kz27,nreg,nfn
13  common/tpr/ switch,gtype,gtype0
14  common/savep/ pi(12)
15  common/iconf/ i1,i2,i3,i4
16 *
17 *
18  DO 1 l = 1,3
19  l1 = 3*(l - 1) + 1
20  l2 = l1 + 1
21  l3 = l2 + 1
22 *
23  k1 = 4*(l - 1) + 1
24  k2 = k1 + 1
25  k3 = k2 + 1
26  k4 = k3 + 1
27 *
28  xr(l1) = q(k1)**2 - q(k2)**2 - q(k3)**2 + q(k4)**2
29  xr(l2) = 2.d0*(q(k1)*q(k2) - q(k3)*q(k4))
30  xr(l3) = 2.d0*(q(k1)*q(k3) + q(k2)*q(k4))
31  r(l) = q(k1)**2 + q(k2)**2 + q(k3)**2 + q(k4)**2
32  a = 0.5d0/r(l)
33  w(l1) = (q(k1)*p(k1) - q(k2)*p(k2) - q(k3)*p(k3) +
34  & q(k4)*p(k4))*a
35  w(l2) = (q(k2)*p(k1) + q(k1)*p(k2) - q(k4)*p(k3) -
36  & q(k3)*p(k4))*a
37  w(l3) = (q(k3)*p(k1) + q(k4)*p(k2) + q(k1)*p(k3) +
38  & q(k2)*p(k4))*a
39  1 CONTINUE
40 *
41  ip1 = i1*3 - 3
42  ip2 = i2*3 - 3
43  ip3 = i3*3 - 3
44  ip4 = i4*3 - 3
45 *
46  DO 2 k = 1,3
47  pi(ip1+k) = -w(k )
48  pi(ip2+k) = w(k ) - w(k+3)
49  pi(ip3+k) = w(k+3) - w(k+6)
50  pi(ip4+k) = w(k+6)
51  x(ip1+k) = -xr(k)
52  x(ip2+k) = 0.0d0
53 * Note terms X(IP1+K) = 0 & X(IP2+K) = XR(K) in early formulation.
54  x(ip3+k) = x(ip2+k) + xr(k+3)
55  x(ip4+k) = x(ip3+k) + xr(k+6)
56  2 CONTINUE
57 *
58 * Skip reduction to centre of mass after switching.
59  IF (switch) RETURN
60 *
61 * Obtain velocities from momenta and form c.m. coordinates.
62  cm(1) = 0.0d0
63  cm(2) = 0.0d0
64  cm(3) = 0.0d0
65  smass = m(1) + m(2) + m(3) + m(4)
66  DO 4 i = 1,4
67  li = 3*(i - 1)
68  DO 3 k = 1,3
69  xd(li+k) = pi(li+k)/m(i)
70  cm(k) = cm(k) + m(i)*x(li+k)/smass
71  3 CONTINUE
72  4 CONTINUE
73 *
74 * Express coordinates in the c.m. frame.
75  l = 0
76  DO 6 i = 1,4
77  DO 5 k = 1,3
78  l = l + 1
79  x(l) = x(l) - cm(k)
80  5 CONTINUE
81  6 CONTINUE
82 *
83  RETURN
84 *
85  END