c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #############################################################
c     ##                                                         ##
c     ##  subroutine ehal3  --  Buffered 14-7 energy & analysis  ##
c     ##                                                         ##
c     #############################################################
c
c
c     "ehal3" calculates the van der Waals interaction energy using
c     Halgren's Buffered 14-7 formalism from the Merck MMFF force
c     field and also partitions the energy among the atoms
c
c
      subroutine ehal3
      implicit none
      include 'sizes.i'
      include 'action.i'
      include 'analyz.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bound.i'
      include 'cell.i'
      include 'couple.i'
      include 'energi.i'
      include 'group.i'
      include 'inform.i'
      include 'iounit.i'
      include 'shunt.i'
      include 'usage.i'
      include 'vdw.i'
      include 'vdwpot.i'
      integer i,j,k,ii,kk,iv,kv
      integer it,kt,skip(maxatm)
      real*8 e,eps,rdn,fgrp
      real*8 rv,rv7,taper
      real*8 xi,yi,zi,xr,yr,zr
      real*8 sigma,kappa,kappa7,rho,tau
      real*8 rik,rik2,rik3,rik4,rik5,rik7
      real*8 xred(maxatm),yred(maxatm),zred(maxatm)
      logical header,huge,proceed,iuse
C hailin
      integer iv14(maxatm)
C hailinend
c
c
c     zero out the van der Waals energy and partitioning terms
c
      nev = 0
      ne14 = 0
      ev = 0.0d0
      e14 = 0.0d0
      do i = 1, n
         aev(i) = 0.0d0
         ae14(i) = 0.0d0
      end do
      header = .true.
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 the van der Waals energy via double loop search
c
      do ii = 1, nvdw-1
         i = ivdw(ii)
         iv = ired(i)
         iuse = (use(i) .or. use(iv))
         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 the energy contribution for this interaction
c
               if (rik2 .le. off2) then
                  rik = sqrt(rik2)
                  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
                  rv7 = rv**7
                  rik7 = rik**7
                  rho = rik7 + (sigma-1.0d0)*rv7
                  tau = rik + (kappa-1.0d0)*rv
                  e = eps * kappa7 * (rv7/tau**7)
     &                   * (sigma*rv7/rho-2.0d0)
c
c     use energy switching if near the cutoff distance
c
                  if (rik2 .gt. cut2) then
                     rik = sqrt(rik2)
                     rik3 = rik2 * rik
                     rik4 = rik2 * rik2
                     rik5 = rik2 * rik3
                     taper = c5*rik5 + c4*rik4 + c3*rik3
     &                          + c2*rik2 + c1*rik + c0
                     e = e * taper
                  end if
c
c     scale the interaction based on its group membership
c
                  if (use_group)  e = e * fgrp
c
c     increment the overall van der Waals energy components
c
                  if (skip(k) .eq. -i) then
                     ne14 = ne14 + 1
                     e14 = e14 + e
                     ae14(i) = ae14(i) + 0.5d0*e
                     ae14(k) = ae14(k) + 0.5d0*e
                  else
                     nev = nev + 1
                     ev = ev + e
                     aev(i) = aev(i) + 0.5d0*e
                     aev(k) = aev(k) + 0.5d0*e
                  end if
c
c     print a warning if the energy of this interaction is large
c
                  huge = (e .gt. 10.0d0)
                  if (debug .or. (verbose.and.huge)) then
                     if (header) then
                        header = .false.
                        write (iout,10)
   10                   format (/,' Individual van der Waals',
     &                             ' Interactions :',
     &                          //,' Type',11x,'Atom Names',
     &                             18x,'Minimum',4x,'Actual',
     &                             6x,'Energy',/)
                     end if
                     write (iout,20)  i,name(i),k,name(k),
     &                                rv,sqrt(rik2),e
   20                format (' VDW-MMFF ',i5,'-',a3,1x,i5,'-',a3,
     &                         12x,2f10.4,f12.4)
                  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))
         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))
            if (proceed)  proceed = (skip(k) .ne. i)
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 the energy contribution for this interaction
c
                  if (rik2 .le. off2) then
                     rik = sqrt(rik2)
                     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
                     rv7 = rv**7
                     rik7 = rik**7
                     rho = rik7 + (sigma-1.0d0)*rv7
                     tau = rik + (kappa-1.0d0)*rv
                     e = eps * kappa7 * (rv7/tau**7)
     &                      * (sigma*rv7/rho-2.0d0)
c
c     use energy switching if near the cutoff distance
c
                     if (rik2 .gt. cut2) then
                        rik = sqrt(rik2)
                        rik3 = rik2 * rik
                        rik4 = rik2 * rik2
                        rik5 = rik2 * rik3
                        taper = c5*rik5 + c4*rik4 + c3*rik3
     &                                + c2*rik2 + c1*rik + c0
                        e = e * taper
                     end if
c
c     scale the interaction based on its group membership
c
                     if (use_group)  e = e * fgrp
c
c     increment the overall van der Waals energy component
c
                     nev = nev + 1
                     if (i .eq. k) then
                        ev = ev + 0.5d0*e
                        aev(i) = aev(i) + 0.5d0*e
                     else
                        ev = ev + e
                        aev(i) = aev(i) + 0.5d0*e
                        aev(k) = aev(k) + 0.5d0*e
                     end if
c
c     print a warning if the energy of this interaction is large
c
                     huge = (e .gt. 10.0d0)
                     if (debug .or. (verbose.and.huge)) then
                        if (header) then
                           header = .false.
                           write (iout,30)
   30                      format (/,' Individual van der Waals',
     &                                ' Interactions :',
     &                             //,' Type',11x,'Atom Names',
     &                                18x,'Minimum',4x,'Actual',
     &                                6x,'Energy',/)
                        end if
                        write (iout,40)  i,name(i),k,name(k),
     &                                   rv,sqrt(rik2),e
   40                   format (' VDW-MMFF ',i5,'-',a3,1x,i5,'-',a3,
     &                            '   (XTAL)   ',2f10.4,f12.4)
                     end if
                  end if
               end do
            end if
         end do
      end do
      return
      end
