c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ############################################################
c     ##                                                        ##
c     ##  subroutine esolv3  --  solvation energy and analysis  ##
c     ##                                                        ##
c     ############################################################
c
c
c     "esolv3" calculates the macroscopic solvation energy using
c     either the Eisenberg-McLachlan ASP, Ooi-Scheraga SASA or
c     Macromodel GB/SA solvation model; also partitions the
c     energy among the atoms
c
c
      subroutine esolv3
      implicit none
      include 'sizes.i'
      include 'action.i'
      include 'analyz.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'energi.i'
      include 'inform.i'
      include 'iounit.i'
      include 'potent.i'
      include 'solute.i'
      integer i
      real*8 earea,epol,probe
      real*8 aarea(maxatm),darea(3,maxatm)
      real*8 aepol(maxatm)
      logical header,huge
c
c
c     zero out the macroscopic solvation energy and partitioning
c
      nes = 0
      es = 0.0d0
      do i = 1, n
         aes(i) = 0.0d0
      end do
c
c     compute the surface area-based solvation energy term
c
      header = .true.
      probe = 1.4d0
      call surface (earea,aarea,darea,rsolv,vsolv,probe)
      nes = nes + n
      es = es + earea
      do i = 1, n
         aes(i) = aes(i) + aarea(i)
      end do
c
c     get the generalized Born term for GB/SA solvation
c
      if (use_gbsa) then
         call born
         call egbsa3 (epol,aepol)
         es = es + epol
         do i = 1, n
            aes(i) = aes(i) + aepol(i)
         end do
      end if
c
c     print a warning if the energy of any atom is large
c
      do i = 1, n
         huge = (abs(aes(i)) .gt. 25.0d0)
         if (debug .or. (verbose.and.huge)) then
            if (header) then
               header = .false.
               write (iout,10)
   10          format (/,' Individual Atomic Solvation Energy',
     &                    ' Terms :',
     &                 //,' Type',11x,'Atom Name',42x,'Energy',/)
            end if
            write (iout,20)  i,name(i),aes(i)
   20       format (' Solvate',7x,i5,'-',a3,37x,f12.4)
         end if
      end do
      return
      end
c
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine egbsa3  --  generalized Born energy & analysis  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "egbsa3" calculates the generalized Born energy term for
c     the Macromodel GB/SA solvation model; also partitions the
c     energy among the atoms
c
c
      subroutine egbsa3 (epol,aepol)
      implicit none
      include 'sizes.i'
      include 'action.i'
      include 'atoms.i'
      include 'bound.i'
      include 'cell.i'
      include 'charge.i'
      include 'shunt.i'
      include 'solute.i'
      include 'units.i'
      include 'usage.i'
      integer i,j,k,ii,kk
      real*8 epol,e,f,fi,fik,fgb,rb2,rm2
      real*8 xi,yi,zi,xr,yr,zr
      real*8 dwater,shift,taper,trans
      real*8 r,r2,r3,r4,r5,r6,r7
      real*8 aepol(maxatm)
      logical iuse
c
c
c     zero out the GB/SA polarization energy and partitioning
c
      epol = 0.0d0
      do i = 1, n
         aepol(i) = 0.0d0
      end do
      if (nion .eq. 0)  return
c
c     set the dielectric constant and energy conversion factor
c
      dwater = 78.3d0
      f = -electric * (1.0d0 - 1.0d0/dwater)
c
c     set cutoff distances and switching function coefficients
c
      call switch ('CHARGE')
c
c     calculate GB/SA electrostatic polarization energy term
c
      do ii = 1, nion
         i = iion(ii)
         iuse = use(i)
         xi = x(i)
         yi = y(i)
         zi = z(i)
         fi = f * pchg(ii)
         do kk = ii, nion
            k = iion(kk)
            if (iuse .or. use(k)) then
               xr = xi - x(k)
               yr = yi - y(k)
               zr = zi - z(k)
               if (use_image)  call image (xr,yr,zr,0)
               r2 = xr*xr + yr*yr + zr*zr
               if (r2 .le. off2) then
                  fik = fi * pchg(kk)
                  rb2 = rborn(i) * rborn(k)
                  fgb = sqrt(r2 + rb2*exp(-0.25d0*r2/rb2))
                  e = fik / fgb
c
c     use shifted energy switching if near the cutoff distance
c
                  rm2 = (0.5d0 * (off+cut))**2
                  shift = fik / sqrt(rm2 + rb2*exp(-0.25d0*rm2/rb2))
                  e = e - shift
                  if (r2 .gt. cut2) then
                     r = sqrt(r2)
                     r3 = r2 * r
                     r4 = r2 * r2
                     r5 = r2 * r3
                     r6 = r3 * r3
                     r7 = r3 * r4
                     taper = c5*r5 + c4*r4 + c3*r3
     &                          + c2*r2 + c1*r + c0
                     trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4
     &                               + f3*r3 + f2*r2 + f1*r + f0)
                     e = e * taper + trans
                  end if
                  nes = nes + 1
                  if (i .eq. k) then
                     epol = epol + 0.5d0*e
                     aepol(i) = aepol(i) + 0.5d0*e
                  else
                     epol = epol + e
                     aepol(i) = aepol(i) + 0.5d0*e
                     aepol(k) = aepol(k) + 0.5d0*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 GB/SA polarization energy with other unit cells
c
      do ii = 1, nion
         i = iion(ii)
         iuse = use(i)
         xi = x(i)
         yi = y(i)
         zi = z(i)
         fi = f * pchg(ii)
         do kk = ii, nion
            k = iion(kk)
            if (iuse .or. use(k)) then
               do j = 1, ncell
                  xr = xi - x(k)
                  yr = yi - y(k)
                  zr = zi - z(k)
                  call image (xr,yr,zr,j)
                  r2 = xr*xr + yr*yr + zr*zr
                  if (r2 .le. off2) then
                     fik = fi * pchg(kk)
                     rb2 = rborn(i) * rborn(k)
                     fgb = sqrt(r2 + rb2*exp(-0.25d0*r2/rb2))
                     e = fik / fgb
c
c     use shifted energy switching if near the cutoff distance
c
                     rm2 = (0.5d0 * (off+cut))**2
                     shift = fik / sqrt(rm2 + rb2*exp(-0.25d0*rm2/rb2))
                     e = e - shift
                     if (r2 .gt. cut2) then
                        r = sqrt(r2)
                        r3 = r2 * r
                        r4 = r2 * r2
                        r5 = r2 * r3
                        r6 = r3 * r3
                        r7 = r3 * r4
                        taper = c5*r5 + c4*r4 + c3*r3
     &                             + c2*r2 + c1*r + c0
                        trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4
     &                                  + f3*r3 + f2*r2 + f1*r + f0)
                        e = e * taper + trans
                     end if
                     nes = nes + 1
                     if (i .eq. k) then
                        epol = epol + 0.5d0*e
                        aepol(i) = aepol(i) + 0.5d0*e
                     else
                        epol = epol + e
                        aepol(i) = aepol(i) + 0.5d0*e
                        aepol(k) = aepol(k) + 0.5d0*e
                     end if
                  end if
               end do
            end if
         end do
      end do
      return
      end
