transk.f

Go to the documentation of this file.

      SUBROUTINE transk
*
*
*       Transformation to physical momenta & separations.
*       -------------------------------------------------
*
      include 'commonc.h'
      include 'common2.h'
      common/ccoll2/  qk(nmx4),pk(nmx4),rij(nmx,nmx),SIZE(nmx),vstar1,
     &                ecoll1,rcoll,qperi,istar(nmx),icoll,isync,ndiss1
*
*
*       Obtain chain momenta & separations of configuration QK & PK.
      DO 1 i = 1,n-1
          ks1 = 4*(i - 1) + 1
          l1 = 3*(i - 1) + 1
          CALL ksphys(qk(ks1),pk(ks1),xc(l1),wc(l1))
          rik = qk(ks1)**2 + qk(ks1+1)**2 + qk(ks1+2)**2 + qk(ks1+3)**2
          rinv(i) = 1.0/rik
    1 CONTINUE
*
*       Obtain physical coordinates.
      DO 2 k = 1,3
          xi(k) = 0.0d0
    2 CONTINUE
      DO 5 i = 1,n-1
          l = 3*(i - 1)
          DO 4 k = 1,3
              xi(l+3+k) = xi(l+k) + xc(l+k)
    4     CONTINUE
    5 CONTINUE
*
*       Form non-singular inverse distances.
      lri = n - 1
      DO 20 i = 1,n-2
          li = 3*(i - 1)
          DO 15 j = i+2,n
              lj = 3*(j - 1)
              rij2 = 0.0d0
              IF (j.GT.i + 2) THEN
                  DO 10 k = 1,3
                      rij2 = rij2 + (xi(lj+k) - xi(li+k))**2
   10             CONTINUE
              ELSE
                  DO 12 k = 1,3
                      rij2 = rij2 + (xc(li+k) + xc(li+k+3))**2
   12             CONTINUE
              END IF
              lri = lri + 1
              rinv(lri) = 1.0/sqrt(rij2)
   15     CONTINUE
   20 CONTINUE
*
*   Transform to physical variables from chain quantities.
      l = 3*(n - 2)
      DO 25 k = 1,3
          pi(k) = -wc(k)
          pi(l+k+3) = wc(l+k)
   25 CONTINUE
*
      DO 30 i = 2,n-1
          l = 3*(i - 1)
          DO 28 k = 1,3
              pi(l+k) = wc(l+k-3) - wc(l+k)
   28     CONTINUE
   30 CONTINUE
*
      RETURN
*
      END