c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###########################################################
c     ##                                                       ##
c     ##  subroutine shakeup  --  setup holonomic constraints  ##
c     ##                                                       ##
c     ###########################################################
c
c
c     "shakeup" initializes any holonomic constraints for use
c     with the rattle algorithm during molecular dynamics
c
c
      subroutine shakeup
      implicit none
      include 'sizes.i'
      include 'angle.i'
      include 'atmlst.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bond.i'
      include 'bound.i'
      include 'couple.i'
      include 'keys.i'
      include 'math.i'
      include 'molcul.i'
      include 'shake.i'
      integer i,j,k,next
      integer ia,ib,ic,ita,itb,itc
      real*8 rab,rbc,rac,cosine
      character*9 rattyp
      character*20 keyword
      character*80 record,string
c
c
c     zero out the number of rattle distance constraints
c
      nrat = 0
      use_rattle = .true.
c
c     search each line of the keyword file for options
c
      do k = 1, nkey
         next = 1
         record = keyline(k)
         call upcase (record)
         call gettext (record,keyword,next)
c
c     get the distance constraint types for the rattle method
c
         if (keyword(1:7) .eq. 'RATTLE ') then
            call getword (record,rattyp,next)
c
c     constrain all bond lengths to their ideal values
c
            if (rattyp(1:5) .eq. 'BONDS') then
               do i = 1, nbond
                  ia = ibnd(1,i)
                  ib = ibnd(2,i)
                  nrat = nrat + 1
                  irat(1,nrat) = ia
                  irat(2,nrat) = ib
                  krat(nrat) = bl(i)
               end do
c
c     constrain 1-3 distance across each angle at ideal value
c
            else if (rattyp(1:6) .eq. 'ANGLES') then
               do i = 1, nangle
                  ia = iang(1,i)
                  ib = iang(2,i)
                  ic = iang(3,i)
                  do j = 1, n12(ib)
                     if (i12(j,ib) .eq. ia) then
                        rab = bl(bndlist(j,ib))
                     else if (i12(j,ib) .eq. ic) then
                        rbc = bl(bndlist(j,ib))
                     end if
                  end do
                  cosine = cos(anat(i)/radian)
                  rac = sqrt(rab**2+rbc**2-2.0d0*rab*rbc*cosine)
                  nrat = nrat + 1
                  irat(1,nrat) = ia
                  irat(2,nrat) = ic
                  krat(nrat) = rac
               end do
c
c     fix bond length in diatomics to give a rigid molecule
c
            else if (rattyp(1:8) .eq. 'DIATOMIC') then
               do i = 1, nbond
                  ia = ibnd(1,i)
                  ib = ibnd(2,i)
                  if (n12(ia).eq.1 .and. n12(ib).eq.1) then
                     nrat = nrat + 1
                     irat(1,nrat) = ia
                     irat(2,nrat) = ib
                     krat(nrat) = bl(i)
                  end if
               end do
c
c     fix bonds and angle in triatomics to give a rigid molecule
c
            else if (rattyp(1:9) .eq. 'TRIATOMIC') then
               do i = 1, nangle
                  ia = iang(1,i)
                  ib = iang(2,i)
                  ic = iang(3,i)
                  if (n12(ia)+n12(ib)+n12(ic) .eq. 4) then
                     rab = bl(bndlist(1,ia))
                     rbc = bl(bndlist(1,ic))
                     cosine = cos(anat(i)/radian)
                     rac = sqrt(rab**2+rbc**2-2.0d0*rab*rbc*cosine)
                     nrat = nrat + 1
                     irat(1,nrat) = ia
                     irat(2,nrat) = ib
                     krat(nrat) = rab
                     nrat = nrat + 1
                     irat(1,nrat) = ib
                     irat(2,nrat) = ic
                     krat(nrat) = rbc
                     nrat = nrat + 1
                     irat(1,nrat) = ia
                     irat(2,nrat) = ic
                     krat(nrat) = rac
                  end if
               end do
c
c     fix bonds and angle of each water to give a rigid molecule
c
            else if (rattyp(1:5) .eq. 'WATER') then
               do i = 1, nangle
                  ia = iang(1,i)
                  ib = iang(2,i)
                  ic = iang(3,i)
                  ita = atomic(ia)
                  itb = atomic(ib)
                  itc = atomic(ic)
                  if (ita.eq.1 .and. itb.eq.8 .and. itc.eq.1) then
                     rab = bl(bndlist(1,ia))
                     rbc = bl(bndlist(1,ic))
                     cosine = cos(anat(i)/radian)
                     rac = sqrt(rab**2+rbc**2-2.0d0*rab*rbc*cosine)
                     nrat = nrat + 1
                     irat(1,nrat) = ia
                     irat(2,nrat) = ib
                     krat(nrat) = rab
                     nrat = nrat + 1
                     irat(1,nrat) = ib
                     irat(2,nrat) = ic
                     krat(nrat) = rbc
                     nrat = nrat + 1
                     irat(1,nrat) = ia
                     irat(2,nrat) = ic
                     krat(nrat) = rac
                  end if
               end do
c
c     fix all bonds to hydrogen atoms at their ideal length
c
            else
               do i = 1, nbond
                  ia = ibnd(1,i)
                  ib = ibnd(2,i)
                  ita = atomic(ia)
                  itb = atomic(ib)
                  if (ita.eq.1 .or. itb.eq.1) then
                     nrat = nrat + 1
                     irat(1,nrat) = ia
                     irat(2,nrat) = ib
                     krat(nrat) = bl(i)
                  end if
               end do
            end if
c
c     fix a single specified atom pair at the desired distance
c
         else if (keyword(1:11) .eq. 'RATTLEBOND ') then
            call getnumb (record,ia,next)
            call getnumb (record,ib,next)
            rab = 0.0d0
            string = record(next:80)
            read (string,*,err=10,end=10)  rab
   10       continue
            if (rab .eq. 0.0d0) then
               do i = 1, n12(ia)
                  if (i12(i,ia) .eq. ib) then
                     rab = bl(bndlist(i,ia))
                  end if
               end do
            end if
            if (rab .eq. 0.0d0) then
               rab = sqrt((x(ia)-x(ib))**2 + (y(ia)-y(ib))**2
     &                           + (z(ia)-z(ib))**2)
            end if
            nrat = nrat + 1
            irat(1,nrat) = ia
            irat(2,nrat) = ib
            krat(nrat) = rab
         end if
      end do
c
c     set flag to apply minimum image to intermolecular rattles
c
      do i = 1, nrat
         ia = irat(1,nrat)
         ib = irat(2,nrat)
         if (use_bounds .and. (molcule(ia).ne.molcule(ib))) then
            ratimage(i) = .true.
         else
            ratimage(i) = .false.
         end if
      end do
c
c     if no rattle constraints are used, turn off its use
c
      if (nrat .eq. 0)  use_rattle = .false.
      return
      end
