Nbody6
transk.f
Go to the documentation of this file.
1  SUBROUTINE transk
2 *
3 *
4 * Transformation to physical momenta & separations.
5 * -------------------------------------------------
6 *
7  include 'commonc.h'
8  include 'common2.h'
9  common/ccoll2/ qk(nmx4),pk(nmx4),rij(nmx,nmx),SIZE(nmx),vstar1,
10  & ecoll1,rcoll,qperi,istar(nmx),icoll,isync,ndiss1
11 *
12 *
13 * Obtain chain momenta & separations of configuration QK & PK.
14  DO 1 i = 1,n-1
15  ks1 = 4*(i - 1) + 1
16  l1 = 3*(i - 1) + 1
17  CALL ksphys(qk(ks1),pk(ks1),xc(l1),wc(l1))
18  rik = qk(ks1)**2 + qk(ks1+1)**2 + qk(ks1+2)**2 + qk(ks1+3)**2
19  rinv(i) = 1.0/rik
20  1 CONTINUE
21 *
22 * Obtain physical coordinates.
23  DO 2 k = 1,3
24  xi(k) = 0.0d0
25  2 CONTINUE
26  DO 5 i = 1,n-1
27  l = 3*(i - 1)
28  DO 4 k = 1,3
29  xi(l+3+k) = xi(l+k) + xc(l+k)
30  4 CONTINUE
31  5 CONTINUE
32 *
33 * Form non-singular inverse distances.
34  lri = n - 1
35  DO 20 i = 1,n-2
36  li = 3*(i - 1)
37  DO 15 j = i+2,n
38  lj = 3*(j - 1)
39  rij2 = 0.0d0
40  IF (j.GT.i + 2) THEN
41  DO 10 k = 1,3
42  rij2 = rij2 + (xi(lj+k) - xi(li+k))**2
43  10 CONTINUE
44  ELSE
45  DO 12 k = 1,3
46  rij2 = rij2 + (xc(li+k) + xc(li+k+3))**2
47  12 CONTINUE
48  END IF
49  lri = lri + 1
50  rinv(lri) = 1.0/sqrt(rij2)
51  15 CONTINUE
52  20 CONTINUE
53 *
54 * Transform to physical variables from chain quantities.
55  l = 3*(n - 2)
56  DO 25 k = 1,3
57  pi(k) = -wc(k)
58  pi(l+k+3) = wc(l+k)
59  25 CONTINUE
60 *
61  DO 30 i = 2,n-1
62  l = 3*(i - 1)
63  DO 28 k = 1,3
64  pi(l+k) = wc(l+k-3) - wc(l+k)
65  28 CONTINUE
66  30 CONTINUE
67 *
68  RETURN
69 *
70  END