c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1991  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine rattle2  --  apply rattle velocity constraints  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "rattle2" implements the second portion of the rattle algorithm
c     by correcting the full-step velocities in order to maintain
c     constrained interatomic distances
c
c
      subroutine rattle2 (dt)
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bath.i'
      include 'inform.i'
      include 'iounit.i'
      include 'moldyn.i'
      include 'shake.i'
      include 'units.i'
      include 'usage.i'
      include 'virial.i'
      integer i,ia,ib,niter,maxiter
      real*8 xr,yr,zr,xv,yv,zv
      real*8 dt,eps,rma,rmb,dot,vterm
      real*8 term,xterm,yterm,zterm
      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 / dt
      vterm = 2.0d0 / (dt * convert)
c
c     apply the rattle algorithm to correct the velocities
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)
               xv = v(1,ib) - v(1,ia)
               yv = v(2,ib) - v(2,ia)
               zv = v(3,ib) - v(3,ia)
               dot = xr*xv + yr*yv + zr*zv
               rma = 1.0d0 / mass(ia)
               rmb = 1.0d0 / mass(ib)
               term = -dot / ((rma+rmb) * krat(i)**2)
               if (abs(term) .gt. eps) then
                  done = .false.
                  update(ia) = .true.
                  update(ib) = .true.
                  xterm = xr * term
                  yterm = yr * term
                  zterm = zr * term
                  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
c
c     increment the virial for use in pressure computation
c
                  if (isobaric) then
                     virx = virx - xr * xterm * vterm
                     viry = viry - yr * yterm * vterm
                     virz = virz - zr * zterm * vterm
                  end if
               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 (/,' RATTLE2  --  Warning, Velocity Constraints',
     &              ' not Satisfied')
         call prterr
         call fatal
      else if (debug) then
         write (iout,20)  niter
   20    format (' RATTLE2  --  Velocity Constraints met at',i6,
     &              ' Iterations')
      end if
      return
      end
