Nbody6
 All Files Functions Variables
newreg.f
Go to the documentation of this file.
1  SUBROUTINE newreg
2 *
3 *
4 * Initialization of chain regularization.
5 * ---------------------------------------
6 *
7  IMPLICIT REAL*8 (a-h,o-z)
8  REAL*8 m,mij
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),cm(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 * Set physical momenta unless switching case (with PI in COMMON).
19  IF (.NOT.switch) THEN
20  DO 4 i = 1,4
21  DO 2 k = 1,3
22  ik = 3*(i - 1) + k
23  pi(ik) = m(i)*xd(ik)
24  2 CONTINUE
25  4 CONTINUE
26  END IF
27 *
28 * Determine vector chain for regularization.
29  CALL status(x,i1,i2,i3,i4)
30  ip1 = 3*(i1 - 1)
31  ip2 = 3*(i2 - 1)
32  ip3 = 3*(i3 - 1)
33  ip4 = 3*(i4 - 1)
34 *
35 * Form appropriate momenta & relative coordinates.
36  DO 5 k = 1,3
37  w(k ) = -pi(ip1+k)
38  w(k+3) = -pi(ip1+k) - pi(ip2+k)
39  w(k+6) = +pi(ip4+k)
40  xr(k ) = x(ip2+k) - x(ip1+k)
41  xr(k+3) = x(ip3+k) - x(ip2+k)
42  xr(k+6) = x(ip4+k) - x(ip3+k)
43  5 CONTINUE
44 *
45 * Perform KS transformations.
46  DO 7 l = 1,3
47  l1 = 3*(l - 1) + 1
48  l2 = l1 + 1
49  l3 = l2 + 1
50  r2 = xr(l1)**2 + xr(l2)**2 + xr(l3)**2
51  r(l) = sqrt(r2)
52  lq1 = 4*(l - 1) + 1
53  lq2 = lq1 + 1
54  lq3 = lq2 + 1
55  lq4 = lq3 + 1
56  q(lq4) = 0.0d0
57  a = r(l) + abs(xr(l1))
58  q(lq1) = sqrt(.5d0*a)
59  b = 1./(2.0d0*q(lq1))
60  q(lq2) = xr(l2)*b
61  q(lq3) = xr(l3)*b
62  IF (xr(l1).LT.0.0d0) THEN
63  u1 = q(lq1)
64  q(lq1) = q(lq2)
65  q(lq2) = u1
66  u3 = q(lq3)
67  q(lq3) = q(lq4)
68  q(lq4) = u3
69  END IF
70  p(lq1) = 2.d0*(+q(lq1)*w(l1) + q(lq2)*w(l2) + q(lq3)*w(l3))
71  p(lq2) = 2.d0*(-q(lq2)*w(l1) + q(lq1)*w(l2) + q(lq4)*w(l3))
72  p(lq3) = 2.d0*(-q(lq3)*w(l1) - q(lq4)*w(l2) + q(lq1)*w(l3))
73  p(lq4) = 2.d0*(+q(lq4)*w(l1) - q(lq3)*w(l2) + q(lq2)*w(l3))
74  7 CONTINUE
75 *
76 * Set mass factors (note scaling by 0.25 for DERQP4).
77  ta(1) = 0.25d0*(.5d0/m(i1) + .5d0/m(i2))
78  ta(2) = 0.25d0*(.5d0/m(i2) + .5d0/m(i3))
79  ta(3) = 0.25d0*(.5d0/m(i3) + .5d0/m(i4))
80  ta(4) = -0.25d0/m(i2)
81  ta(5) = -0.25d0/m(i3)
82  mij(1) = m(i1)*m(i2)
83  mij(2) = m(i2)*m(i3)
84  mij(3) = m(i3)*m(i4)
85  mij(4) = m(i1)*m(i3)
86  mij(5) = m(i2)*m(i4)
87  mij(6) = m(i1)*m(i4)
88 *
89  RETURN
90 *
91  END