c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1994  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine egauss1  --  Gaussian vdw energy & derivatives  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "egauss1" calculates the smoothed van der Waals energy
c     and its first derivatives
c
c
      subroutine egauss1
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'couple.i'
      include 'deriv.i'
      include 'energi.i'
      include 'group.i'
      include 'math.i'
      include 'shunt.i'
      include 'usage.i'
      include 'vdw.i'
      include 'vdwpot.i'
      include 'warp.i'
      integer i,j,k,ii,kk,iv,kv
      integer it,kt,skip(maxatm)
      real*8 e,rik,rik2,rdn,eps,sig2,fgrp
      real*8 xi,yi,zi,xr,yr,zr
      real*8 redi,rediv,redk,redkv
      real*8 dedx,dedy,dedz,de
      real*8 expcut,expterm
      real*8 time,t1,t2,a(4),b(4)
      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')
      expcut = -50.0d0
c
c     scale deformation time by the diffusion coefficient
c
      if (use_deform)  time = diffv * deform
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)
               rik2 = xr*xr + yr*yr + zr*zr
c
c     compute energy and derivatives for this interaction
c
               if (rik2 .le. off2) then
                  eps = epsilon(kt,it)
                  sig2 = (radmin(kt,it)/twosix)**2
C hailin
                  if (iv14(k) .eq. i) then
                     sig2 = (radmin4(kt,it)/twosix)**2
                     eps = epsilon4(kt,it)
                  end if
C hailinend
                  do j = 1, ngauss
                     a(j) = igauss(1,j) * eps
                     b(j) = igauss(2,j) / sig2
                     if (skip(k) .eq. -i)  a(j) = a(j) / vdwscale
                  end do
                  e = 0.0d0
                  de = 0.0d0
                  rik = sqrt(rik2)
c
c     potential smoothing via Scheraga's DEM or Straub's GDA
c
                  if (use_gda) then
                     deform = 0.25d0 * sqrt(m2(i)*m2(k))
                     time = diffv * deform
                  end if
                  if (deform .eq. 0.0d0) then
                     do j = 1, ngauss
                        expterm = -b(j) * rik2
                        if (expterm .gt. expcut) then
                           expterm = a(j)*exp(expterm)
                           e = e + expterm
                           de = de - 2.0d0*b(j)*rik*expterm
                        end if
                     end do
                  else
                     do j = 1, ngauss
                        t1 = 1.0d0 + 4.0d0*b(j)*time
                        t2 = sqrt(t1**3)
                        expterm = -b(j) * rik2 / t1
                        if (expterm .gt. expcut) then
                           expterm = (a(j)/t2)*exp(expterm)
                           e = e + expterm
                           de = de - (2.0d0*b(j)*rik/t1)*expterm
                        end if
                     end do
                  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
               end if
            end if
         end do
      end do
      return
      end
