c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1994  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine egauss3  --  Gaussian vdw energy & analysis  ##
c     ##                                                          ##
c     ##############################################################
c
c
c     "egauss3" calculates the van der Waals interaction energy
c     using a Gaussian approximation and also partitions the
c     energy among the atoms
c
c
      subroutine egauss3
      implicit none
      include 'sizes.i'
      include 'action.i'
      include 'analyz.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'couple.i'
      include 'energi.i'
      include 'group.i'
      include 'inform.i'
      include 'iounit.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,rik2,rdn,eps,sig2,rv,fgrp
      real*8 xi,yi,zi,xr,yr,zr
      real*8 expcut,expterm
      real*8 time,t1,t2,a(4),b(4)
      real*8 xred(maxatm),yred(maxatm),zred(maxatm)
      logical header,huge,proceed,iuse
C hailin
      integer iv14(maxatm)
C hailinendc
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')
      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 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)
               rik2 = xr*xr + yr*yr + zr*zr
c
c     compute the energy contribution 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
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)
     &                     e = e + a(j)*exp(expterm)
                     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)
     &                     e = e + (a(j)/t2)*exp(expterm)
                     end do
                  end if
c
c     scale the interaction based on its group membership
c
                  if (use_group)  e = e * fgrp
c
c     increment the total van der Waals energy components
c
                  if (skip(k) .eq. -i) then
                     ne14 = ne14 + 1
                     ae14(i) = ae14(i) + 0.5d0*e
                     ae14(k) = ae14(k) + 0.5d0*e
                     e14 = e14 + e
                  else
                     nev = nev + 1
                     aev(i) = aev(i) + 0.5d0*e
                     aev(k) = aev(k) + 0.5d0*e
                     ev = ev + 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
                     rv = radmin(kt,it)
                     write (iout,20)  i,name(i),k,name(k),
     &                                rv,sqrt(rik2),e
   20                format (' VDW-Gaus ',i5,'-',a3,1x,i5,'-',a3,
     &                         12x,2f10.4,f12.4)
                  end if
               end if
            end if
         end do
      end do
      return
      end
