c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1994  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##################################################################
c     ##                                                              ##
c     ##  subroutine echarge8  --  atom-wise smoothed charge Hessian  ##
c     ##                                                              ##
c     ##################################################################
c
c
c     "echarge8" calculates second derivatives of the smoothed
c     charge-charge interaction energy for a single atom
c
c
      subroutine echarge8 (i)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'charge.i'
      include 'chgpot.i'
      include 'couple.i'
      include 'group.i'
      include 'hessn.i'
      include 'math.i'
      include 'shunt.i'
      include 'units.i'
      include 'warp.i'
      integer i,j,k,skip(maxatm)
      integer kk,in,kn
      real*8 fi,fik,de,d2e,fgrp
      real*8 d2edx,d2edy,d2edz
      real*8 r,r2,term(3,3)
      real*8 xi,yi,zi,xr,yr,zr
      real*8 erf,erfterm
      real*8 expcut,expterm
      real*8 defterm,time,time2
      logical proceed
c
c
c     first see if the atom of interest carries a charge
c
      do k = 1, nion
         if (iion(k) .eq. i) then
            fi = electric * pchg(k) / dielec
            in = jion(k)
            goto 10
         end if
      end do
      return
   10 continue
c
c     store the coordinates of the atom of interest
c
      xi = x(i)
      yi = y(i)
      zi = z(i)
c
c     set the list of atoms to be skipped
c
      do k = 1, n
         skip(k) = 0
      end do
      skip(in) = i
      do j = 1, n12(in)
         skip(i12(j,in)) = i * chg12use
      end do
      do j = 1, n13(in)
         skip(i13(j,in)) = i * chg13use
      end do
      do j = 1, n14(in)
         skip(i14(j,in)) = i * chg14use
      end do
c
c     set the coefficients of the switching function
c
      call switch ('CHARGE')
c
c     scale deformation time by the diffusion coefficient
c
      if (deform .ne. 0.0d0) then
         expcut = -50.0d0
         time = diffc * deform
         time2 = sqrt(time)
         defterm = 0.5d0 / time2
      end if
c
c     calculate the charge interaction energy Hessian elements
c
      do kk = 1, nion
         k = iion(kk)
         kn = jion(kk)
         proceed = .true.
         if (use_group)  call groups (proceed,fgrp,2,i,k,0,0,0)
         if (proceed)  proceed = (skip(kn) .ne. i)
c
c     compute the energy contribution for this interaction
c
         if (proceed) then
            xr = xi - x(k)
            yr = yi - y(k)
            zr = zi - z(k)
            r2 = xr*xr + yr*yr + zr*zr
            if (r2 .le. off2) then
               r = sqrt(r2)
               fik = fi * pchg(kk)
               if (skip(kn) .eq. -i)  fik = fik / chgscale
c
c     compute chain rule terms for Hessian matrix elements
c
               de = -fik / r2
               d2e = -2.0d0 * de/r
c
c     potential smoothing via the diffusion equation method
c
               if (deform .ne. 0.0d0) then
                  erfterm = erf(defterm*r)
                  expterm = -0.25d0 * r2 / time
                  if (expterm .gt. expcut) then
                     expterm = exp(expterm) / (sqrtpi*time2)
                  else
                     expterm = 0.0d0
                  end if
                  de = de*erfterm + fik*expterm/r
                  d2e = -2.0d0*de/r - 0.5d0*fik*expterm/time
               end if
c
c     scale the interaction based on its group membership
c
               if (use_group) then
                  de = de * fgrp
                  d2e = d2e * fgrp
               end if
c
c     form the individual Hessian element components
c
               de = de / r
               d2e = (d2e-de) / r2
               d2edx = d2e * xr
               d2edy = d2e * yr
               d2edz = d2e * zr
               term(1,1) = d2edx*xr + de
               term(1,2) = d2edx*yr
               term(1,3) = d2edx*zr
               term(2,1) = term(1,2)
               term(2,2) = d2edy*yr + de
               term(2,3) = d2edy*zr
               term(3,1) = term(1,3)
               term(3,2) = term(2,3)
               term(3,3) = d2edz*zr + de
c
c     increment diagonal and non-diagonal Hessian elements
c
               do j = 1, 3
                  hessx(j,i) = hessx(j,i) + term(1,j)
                  hessy(j,i) = hessy(j,i) + term(2,j)
                  hessz(j,i) = hessz(j,i) + term(3,j)
                  hessx(j,k) = hessx(j,k) - term(1,j)
                  hessy(j,k) = hessy(j,k) - term(2,j)
                  hessz(j,k) = hessz(j,k) - term(3,j)
               end do
            end if
         end if
      end do
      return
      end
