transq.f

Go to the documentation of this file.

      SUBROUTINE transq
*
*
*       Transformations from chain variables to KS.
*       -------------------------------------------
*
      include 'commonc.h'
      include 'common2.h'
      REAL*8  ksch
      LOGICAL kslow,kcoll
      common/slow1/   tk2(0:nmx),ejump,ksch(nmx),kslow,kcoll
*
*
*        Centre of mass.
      DO k=1,3
      cmx(k)=0.0
      cmv(k)=0.0
      END DO
      mass=0.0
      DO i=1,n
      l=3*(i-1)
      mc(i)=m(iname(i))
      mass=mass+mc(i)
      DO k=1,3
      cmx(k)=cmx(k)+m(i)*x(l+k)
      cmv(k)=cmv(k)+m(i)*v(l+k)
      END DO
      END DO
*
      DO k=1,3
      cmx(k)=cmx(k)/mass
      cmv(k)=cmv(k)/mass
      END DO
*        Auxiliary quantities.
      DO i=1,n-1
      tkk(i)=.5d0*(1./mc(i)+1./mc(i+1))
      tk1(i)=-1./mc(i)
      mkk(i)=mc(i)*mc(i+1)
      DO j=i+1,n
      mij(i,j)=mc(i)*mc(j)
      mij(j,i)=mij(i,j)
      END DO
      END DO
*
*       Initialize the whole slow-down array TK2.
      DO i=0,n
      tk2(i)=0.0
      END DO
*
*       Pysical momenta.
      DO i=1,n
      l=3*(i-1)
      lf=3*iname(i)-3
      DO k=1,3
      xi(l+k)=x(lf+k)
      pi(l+k)=m(iname(i))*(v(lf+k)-cmv(k))
      END DO
      END DO
*
*        Chain momenta.
      l=3*(n-2)
      DO k=1,3
      wc(k)=-pi(k)
      wc(l+k)=pi(l+k+3)
      END DO
      DO i=2,n-2
      l=3*(i-1)
      DO k=1,3
      wc(l+k)=wc(l+k-3)-pi(l+k)
      END DO
      END DO
*
*       Include artificial STOP to get round compiler bug.
      IF (xi(4)-xi(1).EQ.0.0d0) stop
*
*       Chain coordinates.
      DO i=1,n-1
      l=3*(i-1)
      DO k=1,3
      xc(l+k)=xi(l+k+3)-xi(l+k)
      END DO
      END DO
*
*        KS-transformations.
      DO i=1,n-1
      l1=3*(i-1)+1
      ks1=4*(i-1)+1
      CALL physks(xc(l1),wc(l1),q(ks1),p(ks1))
      END DO
*
      RETURN
      END