c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine ehal1  --  Buffered 14-7 energy & derivatives  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "ehal1" calculates the van der Waals energy and its first
c     derivatives with respect to Cartesian coordinates using
c     Halgren's Buffered 14-7 formalism from the MMFF force field
c
c
      subroutine ehal1
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bath.i'
      include 'bound.i'
      include 'cell.i'
      include 'couple.i'
      include 'deriv.i'
      include 'energi.i'
      include 'group.i'
      include 'inter.i'
      include 'molcul.i'
      include 'shunt.i'
      include 'usage.i'
      include 'vdw.i'
      include 'vdwpot.i'
      include 'virial.i'
      integer i,j,k,ii,kk,iv,kv
      integer it,kt,skip(maxatm)
      real*8 e,eps,rdn,fgrp
      real*8 rv,rv7,rv14
      real*8 xi,yi,zi,xr,yr,zr
      real*8 redi,rediv,redk,redkv
      real*8 de,dedx,dedy,dedz,taper,dtaper
      real*8 sigma,kappa,kappa7,rho,tau
      real*8 rik,rik2,rik3,rik4,rik5,rik6,rik7
      real*8 xred(maxatm),yred(maxatm),zred(maxatm)
      logical proceed,iuse
C hailin
      integer iv14(maxatm)
C hailinend
c
c
c     zero out the van der Waals energy and first derivatives
c
      ev = 0.0d0
      e14 = 0.0d0
      do i = 1, n
         dev(1,i) = 0.0d0
         dev(2,i) = 0.0d0
         dev(3,i) = 0.0d0
         de14(1,i) = 0.0d0
         de14(2,i) = 0.0d0
         de14(3,i) = 0.0d0
      end do
c
c     zero out the list of atoms to be skipped
c
      do i = 1, n
         skip(i) = 0
      end do
C hailin
c     zero out the array marking 1-4 vdw interactions
c     
      do i = 1, n
         iv14(i) = 0
      end do
c
C hailinend
c
c     set the coefficients for the switching function
c
      call switch ('VDW')
c
c     set the values of the two buffering coefficients
c
      sigma = 1.12d0
      kappa = 1.07d0
      kappa7 = kappa**7
c
c     calculate the "reduced" atomic coordinates
c
      do k = 1, nvdw
         i = ivdw(k)
         iv = ired(i)
         rdn = kred(i)
         xred(i) = rdn*(x(i)-x(iv)) + x(iv)
         yred(i) = rdn*(y(i)-y(iv)) + y(iv)
         zred(i) = rdn*(z(i)-z(iv)) + z(iv)
      end do
c
c     find van der Waals energy and derivatives via double loop
c
      do ii = 1, nvdw-1
         i = ivdw(ii)
         iv = ired(i)
         iuse = (use(i) .or. use(iv))
         redi = kred(i)
         rediv = 1.0d0 - redi
         it = class(i)
         xi = xred(i)
         yi = yred(i)
         zi = zred(i)
         do j = 1, n12(i)
            skip(i12(j,i)) = i * vdw12use
         end do
         do j = 1, n13(i)
            skip(i13(j,i)) = i * vdw13use
         end do
         do j = 1, n14(i)
            skip(i14(j,i)) = i * vdw14use
C hailin
            iv14(i14(j,i)) = i
C hailinend
         end do
         do kk = ii+1, nvdw
            k = ivdw(kk)
            kv = ired(k)
c
c     decide whether to compute the current interaction
c
            proceed = .true.
            if (use_group)  call groups (proceed,fgrp,2,i,k,0,0,0)
            if (proceed)  proceed = (iuse .or. use(k) .or. use(kv))
            if (proceed)  proceed = (skip(k) .ne. i)
c
c     compute the energy contribution for this interaction
c
            if (proceed) then
               kt = class(k)
               xr = xi - xred(k)
               yr = yi - yred(k)
               zr = zi - zred(k)
               if (use_image)  call image (xr,yr,zr,0)
               rik2 = xr*xr + yr*yr + zr*zr
c
c     compute energy and derivatives for this interaction
c
               if (rik2 .le. off2) then
                  rv = radmin(kt,it)
                  eps = epsilon(kt,it)
C hailin
                  if (iv14(k) .eq. i) then
                     rv = radmin4(kt,it)
                     eps = epsilon4(kt,it)
                  end if
C hailinend

                  if (skip(k) .eq. -i)  eps = eps / vdwscale
                  rik = sqrt(rik2)
                  rv7 = rv**7
                  rv14 = rv7 * rv7
                  rik6 = rik2**3
                  rik7 = rik6 * rik
                  rho = rik7 + (sigma-1.0d0)*rv7
                  tau = rik + (kappa-1.0d0)*rv
                  e = eps * kappa7 * (rv7/tau**7)
     &                     * (sigma*rv7/rho-2.0d0)
                  de = -7.0d0 * eps * kappa7 * (rv7/tau**8)
     &                      * (sigma*rv7/rho-2.0d0)
     &                 -7.0d0 * eps * kappa7 * sigma * rv14
     &                      * rik6 / (rho**2 * tau**7)
c
c     use energy switching if near the cutoff distance
c
                  if (rik2 .gt. cut2) then
                     rik3 = rik2 * rik
                     rik4 = rik2 * rik2
                     rik5 = rik2 * rik3
                     taper = c5*rik5 + c4*rik4 + c3*rik3
     &                          + c2*rik2 + c1*rik + c0
                     dtaper = 5.0d0*c5*rik4 + 4.0d0*c4*rik3
     &                           + 3.0d0*c3*rik2 + 2.0d0*c2*rik + c1
                     de = e*dtaper + de*taper
                     e = e * taper
                  end if
c
c     scale the interaction based on its group membership
c
                  if (use_group) then
                     e = e * fgrp
                     de = de * fgrp
                  end if
c
c     find the chain rule terms for derivative components
c
                  de = de / rik
                  dedx = de * xr
                  dedy = de * yr
                  dedz = de * zr
c
c     increment the total van der Waals energy and derivatives
c
                  if (skip(k) .eq. -i) then
                     e14 = e14 + e
                     if (i .eq. iv) then
                        de14(1,i) = de14(1,i) + dedx
                        de14(2,i) = de14(2,i) + dedy
                        de14(3,i) = de14(3,i) + dedz
                     else
                        de14(1,i) = de14(1,i) + dedx*redi
                        de14(2,i) = de14(2,i) + dedy*redi
                        de14(3,i) = de14(3,i) + dedz*redi
                        de14(1,iv) = de14(1,iv) + dedx*rediv
                        de14(2,iv) = de14(2,iv) + dedy*rediv
                        de14(3,iv) = de14(3,iv) + dedz*rediv
                     end if
                     if (k .eq. kv) then
                        de14(1,k) = de14(1,k) - dedx
                        de14(2,k) = de14(2,k) - dedy
                        de14(3,k) = de14(3,k) - dedz
                     else
                        redk = kred(k)
                        redkv = 1.0d0 - redk
                        de14(1,k) = de14(1,k) - dedx*redk
                        de14(2,k) = de14(2,k) - dedy*redk
                        de14(3,k) = de14(3,k) - dedz*redk
                        de14(1,kv) = de14(1,kv) - dedx*redkv
                        de14(2,kv) = de14(2,kv) - dedy*redkv
                        de14(3,kv) = de14(3,kv) - dedz*redkv
                     end if
                  else
                     ev = ev + e
                     if (i .eq. iv) then
                        dev(1,i) = dev(1,i) + dedx
                        dev(2,i) = dev(2,i) + dedy
                        dev(3,i) = dev(3,i) + dedz
                     else
                        dev(1,i) = dev(1,i) + dedx*redi
                        dev(2,i) = dev(2,i) + dedy*redi
                        dev(3,i) = dev(3,i) + dedz*redi
                        dev(1,iv) = dev(1,iv) + dedx*rediv
                        dev(2,iv) = dev(2,iv) + dedy*rediv
                        dev(3,iv) = dev(3,iv) + dedz*rediv
                     end if
                     if (k .eq. kv) then
                        dev(1,k) = dev(1,k) - dedx
                        dev(2,k) = dev(2,k) - dedy
                        dev(3,k) = dev(3,k) - dedz
                     else
                        redk = kred(k)
                        redkv = 1.0d0 - redk
                        dev(1,k) = dev(1,k) - dedx*redk
                        dev(2,k) = dev(2,k) - dedy*redk
                        dev(3,k) = dev(3,k) - dedz*redk
                        dev(1,kv) = dev(1,kv) - dedx*redkv
                        dev(2,kv) = dev(2,kv) - dedy*redkv
                        dev(3,kv) = dev(3,kv) - dedz*redkv
                     end if
                  end if
c
c     increment the total intermolecular energy
c
                  if (molcule(i) .ne. molcule(k)) then
                     einter = einter + e
                  end if
c
c     increment the virial for use in pressure computation
c
                  if (isobaric) then
                     virx = virx + xr*dedx
                     viry = viry + yr*dedy
                     virz = virz + zr*dedz
                  end if
               end if
            end if
         end do
      end do
c
c     for periodic boundary conditions with large cutoffs
c     neighbors must be found by the replicates method
c
      if (.not. use_replica)  return
c
c     calculate interaction energy with other unit cells
c
      do ii = 1, nvdw
         i = ivdw(ii)
         iv = ired(i)
         iuse = (use(i) .or. use(iv))
         redi = kred(i)
         rediv = 1.0d0 - redi
         it = class(i)
         xi = xred(i)
         yi = yred(i)
         zi = zred(i)
C hailin
         do j = 1, n14(i)
            iv14(i14(j,i)) = i
         end do
C hailinend
         do kk = ii, nvdw
            k = ivdw(kk)
            kv = ired(k)
c
c     decide whether to compute the current interaction
c
            proceed = .true.
            if (use_group)  call groups (proceed,fgrp,2,i,k,0,0,0)
            if (proceed)  proceed = (iuse .or. use(k) .or. use(kv))
c
c     compute the energy contribution for this interaction
c
            if (proceed) then
               do j = 1, ncell
                  kt = class(k)
                  xr = xi - xred(k)
                  yr = yi - yred(k)
                  zr = zi - zred(k)
                  call image (xr,yr,zr,j)
                  rik2 = xr*xr + yr*yr + zr*zr
c
c     compute energy and derivatives for this interaction
c
                  if (rik2 .le. off2) then
                     rv = radmin(kt,it)
                     eps = epsilon(kt,it)
C hailin
                           if (iv14(k) .eq. i) then
                              rv = radmin4(kt,it)
                              eps = epsilon4(kt,it)
                           end if
C hailinend
                     rik = sqrt(rik2)
                     rv7 = rv**7
                     rv14 = rv7 * rv7
                     rik6 = rik2**3
                     rik7 = rik6 * rik
                     rho = rik7 + (sigma-1.0d0)*rv7
                     tau = rik + (kappa-1.0d0)*rv
                     e = eps * kappa7 * (rv7/tau**7)
     &                        * (sigma*rv7/rho-2.0d0)
                     de = -7.0d0 * eps * kappa7 * (rv7/tau**8)
     &                         * (sigma*rv7/rho-2.0d0)
     &                    -7.0d0 * eps * kappa7 * sigma * rv14
     &                         * rik6 / (rho**2 * tau**7)
c
c     use energy switching if near the cutoff distance
c
                     if (rik2 .gt. cut2) then
                        rik3 = rik2 * rik
                        rik4 = rik2 * rik2
                        rik5 = rik2 * rik3
                        taper = c5*rik5 + c4*rik4 + c3*rik3
     &                             + c2*rik2 + c1*rik + c0
                        dtaper = 5.0d0*c5*rik4 + 4.0d0*c4*rik3
     &                              + 3.0d0*c3*rik2 + 2.0d0*c2*rik + c1
                        de = e*dtaper + de*taper
                        e = e * taper
                     end if
c
c     scale the interaction based on its group membership
c
                     if (use_group) then
                        e = e * fgrp
                        de = de * fgrp
                     end if
c
c     find the chain rule terms for derivative components
c
                     de = de / rik
                     dedx = de * xr
                     dedy = de * yr
                     dedz = de * zr
c
c     increment the total van der Waals energy and derivatives
c
                     if (i .eq. k)  e = 0.5d0 * e
                     ev = ev + e
                     if (i .eq. iv) then
                        dev(1,i) = dev(1,i) + dedx
                        dev(2,i) = dev(2,i) + dedy
                        dev(3,i) = dev(3,i) + dedz
                     else
                        dev(1,i) = dev(1,i) + dedx*redi
                        dev(2,i) = dev(2,i) + dedy*redi
                        dev(3,i) = dev(3,i) + dedz*redi
                        dev(1,iv) = dev(1,iv) + dedx*rediv
                        dev(2,iv) = dev(2,iv) + dedy*rediv
                        dev(3,iv) = dev(3,iv) + dedz*rediv
                     end if
                     if (i .ne. k) then
                        if (k .eq. kv) then
                           dev(1,k) = dev(1,k) - dedx
                           dev(2,k) = dev(2,k) - dedy
                           dev(3,k) = dev(3,k) - dedz
                        else
                           redk = kred(k)
                           redkv = 1.0d0 - redk
                           dev(1,k) = dev(1,k) - dedx*redk
                           dev(2,k) = dev(2,k) - dedy*redk
                           dev(3,k) = dev(3,k) - dedz*redk
                           dev(1,kv) = dev(1,kv) - dedx*redkv
                           dev(2,kv) = dev(2,kv) - dedy*redkv
                           dev(3,kv) = dev(3,kv) - dedz*redkv
                        end if
                     end if
c
c     increment the total intermolecular energy
c
                     einter = einter + e
c
c     increment the virial for use in pressure computation
c
                     if (isobaric) then
                        virx = virx + xr*dedx
                        viry = viry + yr*dedy
                        virz = virz + zr*dedz
                     end if
                  end if
               end do
            end if
         end do
      end do
      return
      end
