Nbody6
 All Files Functions Variables
trans4.f
Go to the documentation of this file.
1  SUBROUTINE trans4
2 *
3 *
4 * Transformation to physical momenta & separations.
5 * -------------------------------------------------
6 *
7  IMPLICIT REAL*8 (a-h,o-z)
8  REAL*8 m,mij,xnr(9)
9  common/creg/ m(4),x(12),xd(12),p(12),q(12),time4,energy,epsr2,
10  & xr(9),w(9),r(6),ta(6),mij(6),cmx(10),rmax4,tmax,
11  & ds,tstep,eps,nstep4,name4(4),kz15,kz27,nreg,nfn
12  common/ccoll/ qk(12),pk(12),icall,icoll,ndiss4
13  common/iconf/ i1,i2,i3,i4
14  common/savep/ pi(12)
15 *
16 *
17 * Form KS coordinates & chain momenta from configuration QK & PK.
18  DO 1 l = 1,3
19  l1 = 3*(l - 1) + 1
20  l2 = l1 + 1
21  l3 = l2 + 1
22 *
23  j1 = 4*(l - 1) + 1
24  j2 = j1 + 1
25  j3 = j2 + 1
26  j4 = j3 + 1
27 *
28  xr(l1) = qk(j1)**2 - qk(j2)**2 - qk(j3)**2 + qk(j4)**2
29  xr(l2) = 2.d0*(qk(j1)*qk(j2) - qk(j3)*qk(j4))
30  xr(l3) = 2.d0*(qk(j1)*qk(j3) + qk(j2)*qk(j4))
31  r(l) = qk(j1)**2 + qk(j2)**2 + qk(j3)**2 + qk(j4)**2
32 *
33  a = 0.5d0/r(l)
34  w(l1) = (qk(j1)*pk(j1) - qk(j2)*pk(j2) - qk(j3)*pk(j3) +
35  & qk(j4)*pk(j4))*a
36  w(l2) = (qk(j2)*pk(j1) + qk(j1)*pk(j2) - qk(j4)*pk(j3) -
37  & qk(j3)*pk(j4))*a
38  w(l3) = (qk(j3)*pk(j1) + qk(j4)*pk(j2) + qk(j1)*pk(j3) +
39  & qk(j2)*pk(j4))*a
40  1 CONTINUE
41 *
42  j1 = 3*(i1 - 1)
43  j2 = 3*(i2 - 1)
44  j3 = 3*(i3 - 1)
45  j4 = 3*(i4 - 1)
46 *
47 * Obtain physical momenta of configuration I1, I2, I3, I4.
48  DO 10 k = 1,3
49  pi(j1+k) = -w(k )
50  pi(j2+k) = w(k ) - w(k+3)
51  pi(j3+k) = w(k+3) - w(k+6)
52  pi(j4+k) = w(k+6)
53  r(k+3) = 0.0d0
54  10 CONTINUE
55 *
56 * Update irregular distances.
57  DO 15 k = 1,3
58  xnr(k ) = xr(k ) + xr(k+3)
59  xnr(k+3) = xr(k+3) + xr(k+6)
60  xnr(k+6) = xnr(k ) + xr(k+6)
61  r(4) = r(4) + xnr(k )**2
62  r(5) = r(5) + xnr(k+3)**2
63  r(6) = r(6) + xnr(k+6)**2
64  15 CONTINUE
65  DO 20 i = 4,6
66  r(i) = sqrt(r(i))
67  20 CONTINUE
68 *
69  RETURN
70 *
71  END