c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine ebuck4  --  Buckingham van der Waals energy  ##
c     ##                                                          ##
c     ##############################################################
c
c
c     "ebuck4" calculates the Lennard-Jones van der Waals interaction
c     energy using the method of lights to locate neighboring atoms
c
c
      subroutine ebuck4
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bound.i'
      include 'boxes.i'
      include 'cell.i'
      include 'couple.i'
      include 'energi.i'
      include 'group.i'
      include 'iounit.i'
      include 'light.i'
      include 'shunt.i'
      include 'usage.i'
      include 'vdw.i'
      include 'vdwpot.i'
      integer i,j,k,ii,kk,iv,it,kt
      integer kgy,kgz,start,stop
      integer kskip,skip(maxatm)
      integer kmap,kvmap,map(maxlight)
      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)
      real*8 xsort(maxlight),ysort(maxlight),zsort(maxlight)
      logical proceed,iuse,repeat
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)
         ii = ired(i)
         rdn = kred(i)
         xred(k) = rdn*(x(i)-x(ii)) + x(ii)
         yred(k) = rdn*(y(i)-y(ii)) + y(ii)
         zred(k) = rdn*(z(i)-z(ii)) + z(ii)
      end do
c
c     transfer the interaction site coordinates to sorting arrays
c
      do i = 1, nvdw
         xsort(i) = xred(i)
         ysort(i) = yred(i)
         zsort(i) = zred(i)
      end do
c
c     use the method of lights to generate neighbors
c
      call lights (nvdw,map,xsort,ysort,zsort)
c
c     now, loop over all atoms computing the interactions
c
      do ii = 1, nvdw
         i = ivdw(ii)
         iv = ired(i)
         iuse = (use(i) .or. use(iv))
         it = class(i)
         xi = xsort(rgx(ii))
         yi = ysort(rgy(ii))
         zi = zsort(rgz(ii))
         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
         if (kbx(ii) .le. kex(ii)) then
            repeat = .false.
            start = kbx(ii) + 1
            stop = kex(ii)
         else
            repeat = .true.
            start = 1
            stop = kex(ii)
         end if
   10    continue
         do j = start, stop
            kk = locx(j)
            kgy = rgy(kk)
            if (kby(ii) .le. key(ii)) then
               if (kgy.lt.kby(ii) .or. kgy.gt.key(ii))  goto 20
            else
               if (kgy.lt.kby(ii) .and. kgy.gt.key(ii))  goto 20
            end if
            kgz = rgz(kk)
            if (kbz(ii) .le. kez(ii)) then
               if (kgz.lt.kbz(ii) .or. kgz.gt.kez(ii))  goto 20
            else
               if (kgz.lt.kbz(ii) .and. kgz.gt.kez(ii))  goto 20
            end if
            if (kk .le. nvdw) then
               kskip = skip(ivdw(kk))
               if (kskip .eq. i)  goto 20
            else
               kskip = 0
            end if
            kmap = ivdw(map(kk))
            kvmap = ired(kmap)
c
c     decide whether to compute the current interaction
c
            proceed = .true.
            if (use_group)  call groups (proceed,fgrp,2,i,kmap,0,0,0)
            if (proceed)  proceed = (iuse .or. use(kmap)
     &                                .or. use(kvmap))
c
c     compute the energy contribution for this interaction
c
            if (proceed) then
               kt = class(kmap)
               xr = xi - xsort(j)
               yr = yi - ysort(kgy)
               zr = zi - zsort(kgz)
               if (use_image) then
                  if (abs(xr) .gt. xcell2)  xr = xr - sign(xcell,xr)
                  if (abs(yr) .gt. ycell2)  yr = yr - sign(ycell,yr)
                  if (abs(zr) .gt. zcell2)  zr = zr - sign(zcell,zr)
                  if (monoclinic) then
                     xr = xr + zr*beta_cos
                     zr = zr * beta_sin
                  else if (triclinic) then
                     xr = xr + yr*gamma_cos + zr*beta_cos
                     yr = yr*gamma_sin + zr*beta_term
                     zr = zr * gamma_term
                  end if
               end if
               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
                     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 (kskip .eq. -i) then
                     e14 = e14 + e
                  else
                     ev = ev + e
                  end if
               end if
            end if
   20       continue
         end do
         if (repeat) then
            repeat = .false.
            start = kbx(ii) + 1
            stop = nlight
            goto 10
         end if
      end do
      return
      end
