c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1997  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###########################################################
c     ##                                                       ##
c     ##  subroutine hessrgd  --  rigid body Hessian elements  ##
c     ##                                                       ##
c     ###########################################################
c
c
c     "hessrgd" computes the numerical Hessian elements with
c     respect to rigid body coordinates; either the full matrix
c     or just the diagonal can be calculated; the full matrix
c     needs 6*ngroup+1 gradient evaluations while the diagonal
c     requires just two gradient calls
c
c
      subroutine hessrgd (mode,hrigid)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'group.i'
      include 'rigid.i'
      integer maxrgd
      parameter (maxrgd=6*maxgrp)
      integer i,j,k,m,nvar
      real*8 eps,old(6,maxgrp)
      real*8 e,g(6,maxgrp),g0(6,maxgrp)
      real*8 hrigid(maxrgd,maxrgd)
      character*4 mode
c
c
c     calculate base values for the rigid body gradient
c
      eps = 0.0001d0
      call gradrgd (e,g0)
c     
c     compute one-sided numerical Hessian from gradient values;
c     set off-diagonal elements to the average symmetric value
c
      if (mode .eq. 'full') then
         nvar = 6 * ngrp
         do i = 1, nvar
            j = (i-1)/6 + 1
            k = mod(i-1,6) + 1
            old(k,j) = rbc(k,j)
            rbc(k,j) = rbc(k,j) + eps
            call rigidxyz
            call gradrgd (e,g)
            do m = 1, nvar
               hrigid(m,i) = (g(k,j) - g0(k,j)) / eps
            end do
            do m = 1, i-1
               hrigid(m,i) = 0.5d0 * (hrigid(m,i)+hrigid(i,m))
               hrigid(i,m) = hrigid(m,i)
            end do
            rbc(k,j) = old(k,j)
         end do
c
c     compute numerical Hessian diagonal from gradient values
c
      else if (mode .eq. 'diag') then
         do i = 1, ngrp
            do j = 1, 6
               old(j,i) = rbc(j,i)
               rbc(j,i) = rbc(j,i) + eps
            end do
         end do
         call rigidxyz
         call gradrot (e,g)
         nvar = 0
         do i = 1, ngrp
            do j = 1, 6
               nvar = nvar + 1
               hrigid(nvar,nvar) = (g(j,i)-g0(j,i)) / eps
               rbc(j,i) = old(j,i)
            end do
         end do
      end if
c
c     restore the Cartesian coordinates to original values
c
      call rigidxyz
      return
      end
