c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1991  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine rattle  --  apply rattle position constraints  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "rattle" implements the first portion of the rattle algorithm
c     by correcting atomic positions and half-step velocities to
c     maintain constrained interatomic distances
c
c     Literature Reference:
c
c     H. C. Andersen, "Rattle: A Velocity Version of the Shake
c     Algorithm for Molecular Dynamics Calculations", Journal of
c     Computational Physics, 52, 24-34 (1983)
c
c
      subroutine rattle (dt,xold,yold,zold)
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'inform.i'
      include 'iounit.i'
      include 'moldyn.i'
      include 'shake.i'
      include 'usage.i'
      integer i,ia,ib,niter,maxiter
      real*8 dt,xr,yr,zr,xo,yo,zo
      real*8 eps,dist2,delta,rma,rmb
      real*8 dot,term,xterm,yterm,zterm
      real*8 xold(maxatm),yold(maxatm),zold(maxatm)
      logical done,moved(maxatm),update(maxatm)
c
c
c     initialize the lists of atoms previously corrected
c
      do i = 1, n
         if (use(i)) then
            moved(i) = .true.
         else
            moved(i) = .false.
         end if
         update(i) = .false.
      end do
c
c     set the iteration counter, termination and tolerance
c
      maxiter = 100
      niter = 0
      done = .false.
      eps = 0.000001d0
c
c     apply the rattle algorithm to correct the atom
c     positions and the half-step velocity values
c
      dowhile (.not.done .and. niter.lt.maxiter)
         niter = niter + 1
         done = .true.
         do i = 1, nrat
            ia = irat(1,i)
            ib = irat(2,i)
            if (moved(ia) .or. moved(ib)) then
               xr = x(ib) - x(ia)
               yr = y(ib) - y(ia)
               zr = z(ib) - z(ia)
               if (ratimage(i))  call image (xr,yr,zr,0)
               dist2 = xr**2 + yr**2 + zr**2
               delta = krat(i)**2 - dist2
               if (abs(delta) .gt. eps) then
                  done = .false.
                  update(ia) = .true.
                  update(ib) = .true.
                  xo = xold(ib) - xold(ia)
                  yo = yold(ib) - yold(ia)
                  zo = zold(ib) - zold(ia)
                  if (ratimage(i))  call image (xo,yo,zo,0)
                  dot = xr*xo + yr*yo + zr*zo
                  rma = 1.0d0 / mass(ia)
                  rmb = 1.0d0 / mass(ib)
                  term = delta / (2.0d0 * (rma+rmb) * dot)
                  xterm = xo * term
                  yterm = yo * term
                  zterm = zo * term
                  x(ia) =  x(ia) - xterm * rma
                  y(ia) =  y(ia) - yterm * rma
                  z(ia) =  z(ia) - zterm * rma
                  x(ib) =  x(ib) + xterm * rmb
                  y(ib) =  y(ib) + yterm * rmb
                  z(ib) =  z(ib) + zterm * rmb
                  rma = rma / dt
                  rmb = rmb / dt
                  v(1,ia) = v(1,ia) - xterm * rma
                  v(2,ia) = v(2,ia) - yterm * rma
                  v(3,ia) = v(3,ia) - zterm * rma
                  v(1,ib) = v(1,ib) + xterm * rmb
                  v(2,ib) = v(2,ib) + yterm * rmb
                  v(3,ib) = v(3,ib) + zterm * rmb
               end if
            end if
         end do
         do i = 1, n
            moved(i) = update(i)
            update(i) = .false.
         end do
      end do
c
c     write information on the number of iterations needed
c
      if (niter .eq. maxiter) then
         write (iout,10)
   10    format (/,' RATTLE  --  Warning, Position Constraints',
     &              ' not Satisfied')
         call prterr
         call fatal
      else if (debug) then
         write (iout,20)  niter
   20    format (' RATTLE   --  Position Constraints met at',i6,
     &              ' Iterations')
      end if
      return
      end
