xtf.f

Go to the documentation of this file.

      SUBROUTINE xtf(FW,FV,XCM,CHTIME)
*
*
*       External chain force.
*       ---------------------
*
      include 'commonc.h'
      REAL*8 fw(nmx3),fv(3),xcm(3)
      REAL*8 acc(nmx3),ddp(nmx3),q0(3)
*
*
      DO k=1,3
      q0(k)=0.0
      END DO
*
      DO i=1,n
      l=3*(i-1)
      DO k=1,3
      q0(k)=q0(k)+xi(l+k)*mc(i)/mass
      END DO
      END DO
*
*       Re-arrange according to INAME(I) and add c.m. (if needed).
      DO i=1,n
      l=3*(i-1)
      lf=3*(iname(i)-1)
      DO k=1,3
      x(lf+k)=xi(l+k)-q0(k)
*    &       +XCM(K)
      END DO
      END DO
*
*       Obtain the perturbing accelerations.
      CALL xtpert(acc,chtime)
*
*   Centre of mass force.
      DO k=1,3
      fv(k)=0.0
      END DO
      DO i=1,n
      l=3*(i-1)
      DO k=1,3
      fv(k)=fv(k)+m(i)/mass*acc(l+k)
      END DO
      END DO
*
*       Physical chain forces.
      DO i=1,n
      l=3*(i-1)
      lf=3*(iname(i)-1)
      DO k=1,3
      ddp(l+k)=mc(i)*(acc(lf+k)-fv(k))
      END DO
      END DO
*
      l=3*(n-2)
      DO k=1,3
      fw(k)=-ddp(k)
      fw(l+k)=ddp(l+k+3)
      END DO
      DO i=2,n-2
      l=3*(i-1)
      DO k=1,3
      fw(l+k)=fw(l+k-3)-ddp(l+k)
      END DO
      END DO
*
      RETURN
      END