const.f

Go to the documentation of this file.

      SUBROUTINE const(X,XD,M,NB,ENERGY,G,ALAG)
*
*
*       Constants of motion.
*       --------------------
*
      IMPLICIT REAL*8 (a-h,m,o-z)
      REAL*8 x(3*nb),xd(3*nb),g(3),m(nb)
*
*
      t=0.0
      ug=0.0
*       Suppress external potential (not used here).
*     CALL XTRNLU(X,M,NB,UG)
      u=ug
      g(1)=0.
      g(2)=0.
      g(3)=0.
*
      DO 10 i=1,nb
      k1=3*(i-1)+1
      k2=k1+1
      k3=k2+1
      t=t+.5d0*m(i)*(xd(k1)**2+xd(k2)**2+xd(k3)**2)
      g(1)=g(1)+m(i)*(x(k2)*xd(k3)-x(k3)*xd(k2))
      g(2)=g(2)-m(i)*(x(k1)*xd(k3)-x(k3)*xd(k1))
      g(3)=g(3)+m(i)*(x(k1)*xd(k2)-x(k2)*xd(k1))
      IF(i.EQ.nb)go to 10
      j1=i+1
      DO 9 j=j1,nb
      ki=3*(i-1)
      kj=3*(j-1)
      r2=0.
      DO 8 k=1,3
      ki=ki+1
      kj=kj+1
      r2=r2+(x(ki)-x(kj))**2
8     CONTINUE
      u=u+m(i)*m(j)/sqrt(r2)
9     CONTINUE
10    CONTINUE
*
*       Form the total energy and Lagrangean energy.
      energy=t-u
      alag=t+u
*
      RETURN
      END