c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #############################################################
c     ##                                                         ##
c     ##  subroutine ebuck  --  Buckingham van der Waals energy  ##
c     ##                                                         ##
c     #############################################################
c
c
c     "ebuck" calculates the van der Waals interaction energy
c     using the Buckingham exp-6 formalism
c
c
      subroutine ebuck
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bound.i'
      include 'cell.i'
      include 'couple.i'
      include 'energi.i'
      include 'group.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,rv,eps,rdn
      real*8 p,p2,p6,p12,fgrp
      real*8 xi,yi,zi,xr,yr,zr
      real*8 rik,rik2,rik3,rik4,rik5,taper
      real*8 expcut,expcut2,expterm,expmerge
      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 contributions
c
      ev = 0.0d0
      e14 = 0.0d0
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     switch from exponential to R^12 at very short range
c
      expcut = 2.0d0
      expcut2 = expcut * expcut
      expmerge = (aterm*exp(-bterm/expcut) - cterm*(expcut**6))
     &                               / (expcut**12)
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
                  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
                  p2 = (rv*rv) / rik2
                  p6 = p2 * p2 * p2
c jcc             if (p2 .le. expcut2) then
                     p = sqrt(p2)
                     expterm = aterm * exp(-bterm/p)
                     e = eps * (expterm - cterm*p6)
c jcc             else
                     p12 = p6 * p6
c jcc                e = expmerge * eps * p12
c                     e = e + dterm * expmerge * eps * p12                           0607OT05
c jcc             end if
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
                     e14 = e14 + e
                  else
                     ev = ev + e
                  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))
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
                     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
                     p2 = (rv*rv) / rik2
                     p6 = p2 * p2 * p2
c jcc                if (p2 .le. expcut2) then
                        p = sqrt(p2)
                        expterm = aterm * exp(-bterm/p)
                        e = eps * (expterm - cterm*p6)
c jcc                else
                        p12 = p6 * p6
c jcc                   e = expmerge * eps * p12
c                        e = e + dterm * expmerge * eps * p12                            0607OT05
c jcc                end if
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     interaction of an atom with its own image counts half
c
                     if (i .eq. k)  e = 0.5d0 * e
                     ev = ev + e
                  end if
               end do
            end if
         end do
      end do
      return
      end
