trans4.f

Go to the documentation of this file.

      SUBROUTINE trans4
*
*
*       Transformation to physical momenta & separations.
*       -------------------------------------------------
*
      IMPLICIT REAL*8  (a-h,o-z)
      REAL*8  m,mij,xnr(9)
      common/creg/  m(4),x(12),xd(12),p(12),q(12),time4,energy,epsr2,
     &              xr(9),w(9),r(6),ta(6),mij(6),cmx(10),rmax4,tmax,
     &              ds,tstep,eps,nstep4,name4(4),kz15,kz27,nreg,nfn
      common/ccoll/  qk(12),pk(12),icall,icoll,ndiss4
      common/iconf/  i1,i2,i3,i4
      common/savep/  pi(12)
*
*
*       Form KS coordinates & chain momenta from configuration QK & PK.
      DO 1 l = 1,3
          l1 = 3*(l - 1) + 1
          l2 = l1 + 1
          l3 = l2 + 1
*
          j1 = 4*(l - 1) + 1
          j2 = j1 + 1
          j3 = j2 + 1
          j4 = j3 + 1
*
          xr(l1) = qk(j1)**2 - qk(j2)**2 - qk(j3)**2 + qk(j4)**2
          xr(l2) = 2.d0*(qk(j1)*qk(j2) - qk(j3)*qk(j4))
          xr(l3) = 2.d0*(qk(j1)*qk(j3) + qk(j2)*qk(j4))
          r(l) = qk(j1)**2 + qk(j2)**2 + qk(j3)**2 + qk(j4)**2
*
          a = 0.5d0/r(l)
          w(l1) = (qk(j1)*pk(j1) - qk(j2)*pk(j2) - qk(j3)*pk(j3) +
     &                                             qk(j4)*pk(j4))*a
          w(l2) = (qk(j2)*pk(j1) + qk(j1)*pk(j2) - qk(j4)*pk(j3) -
     &                                             qk(j3)*pk(j4))*a
          w(l3) = (qk(j3)*pk(j1) + qk(j4)*pk(j2) + qk(j1)*pk(j3) +
     &                                             qk(j2)*pk(j4))*a
    1 CONTINUE
*
      j1 = 3*(i1 - 1)
      j2 = 3*(i2 - 1)
      j3 = 3*(i3 - 1)
      j4 = 3*(i4 - 1)
*
*       Obtain physical momenta of configuration I1, I2, I3, I4.
      DO 10 k = 1,3
          pi(j1+k) = -w(k  )
          pi(j2+k) =  w(k  ) - w(k+3)
          pi(j3+k) =  w(k+3) - w(k+6)
          pi(j4+k) =  w(k+6)
          r(k+3) = 0.0d0
   10 CONTINUE
*
*       Update irregular distances.
      DO 15 k = 1,3
          xnr(k  ) = xr(k  ) + xr(k+3)
          xnr(k+3) = xr(k+3) + xr(k+6)
          xnr(k+6) = xnr(k ) + xr(k+6)
          r(4) = r(4) + xnr(k  )**2
          r(5) = r(5) + xnr(k+3)**2
          r(6) = r(6) + xnr(k+6)**2
   15 CONTINUE
      DO 20 i = 4,6
          r(i) = sqrt(r(i))
   20 CONTINUE
*
      RETURN
*
      END