c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##########################################################
c     ##                                                      ##
c     ##  subroutine esolv  --  macroscopic solvation energy  ##
c     ##                                                      ##
c     ##########################################################
c
c
c     "esolv" calculates the macroscopic solvation energy via
c     either the Eisenberg-McLachlan ASP, Ooi-Scheraga SASA or
c     Macromodel GB/SA solvation model
c
c
      subroutine esolv
      implicit none
      include 'sizes.i'
      include 'energi.i'
      include 'potent.i'
      include 'solute.i'
      real*8 earea,epol,probe
      real*8 aarea(maxatm),darea(3,maxatm)
c
c
c     zero out the macroscopic solvation energy
c
      es = 0.0d0
c
c     compute the surface area-based solvation energy term
c
      probe = 1.4d0
      call surface (earea,aarea,darea,rsolv,vsolv,probe)
      es = es + earea
c
c     get the generalized Born term for GB/SA solvation
c
      if (use_gbsa) then
         call born
         call egbsa (epol)
         es = es + epol
      end if
      return
      end
c
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine egbsa  --  generalized Born energy for GB/SA  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "egbsa" calculates the generalized Born energy term
c     for the Macromodel GB/SA solvation model
c
c
      subroutine egbsa (epol)
      implicit none
      include 'sizes.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
      logical iuse
c
c
c     zero out the GB/SA polarization energy
c
      epol = 0.0d0
      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
                  if (i .eq. k)  e = 0.5d0 * e
                  epol = epol + e
               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
                     if (i .eq. k)  e = 0.5d0 * e
                     epol = epol + e
                  end if
               end do
            end if
         end do
      end do
      return
      end
