c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine esolv1  --  solvation energy and derivatives  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "esolv1" calculates the macroscopic solvation energy and
c     first derivatives with respect to Cartesian coordinates
c     using either the Eisenberg-McLachlan ASP, Ooi-Scheraga SASA
c     or Macromodel GB/SA solvation model
c
c
      subroutine esolv1
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'deriv.i'
      include 'energi.i'
      include 'potent.i'
      include 'solute.i'
      integer i,j
      real*8 earea,epol,probe
      real*8 aarea(maxatm),darea(3,maxatm)
      real*8 depol(3,maxatm)
c
c
c     zero out the macroscopic solvation energy and derivatives
c
      es = 0.0d0
      do i = 1, n
         des(1,i) = 0.0d0
         des(2,i) = 0.0d0
         des(3,i) = 0.0d0
      end do
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
      do i = 1, n
         do j = 1, 3
            des(j,i) = des(j,i) + darea(j,i)
         end do
      end do
c
c     get the generalized Born term for GB/SA solvation
c
      if (use_gbsa) then
         call born
         call egbsa1 (epol,depol)
         es = es + epol
         do i = 1, n
            do j = 1, 3
               des(j,i) = des(j,i) + depol(j,i)
            end do
         end do
      end if
      return
      end
c
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine egbsa1  --  generalized Born energy for GB/SA  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "egbsa1" calculates the generalized Born energy and first
c     derivatives with respect to Cartesian coordinates for the
c     Macromodel GB/SA solvation model
c
c
      subroutine egbsa1 (epol,depol)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'bath.i'
      include 'bound.i'
      include 'cell.i'
      include 'charge.i'
      include 'inter.i'
      include 'molcul.i'
      include 'shunt.i'
      include 'solute.i'
      include 'units.i'
      include 'usage.i'
      include 'virial.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 dedx,dedy,dedz,de,dwater
      real*8 shift,taper,dtaper,trans,dtrans
      real*8 r,r2,r3,r4,r5,r6,r7,expterm
      real*8 depol(3,maxatm)
      logical iuse
c
c
c     zero out the GB/SA polarization energy and derivatives
c
      epol = 0.0d0
      do i = 1, n
         depol(1,i) = 0.0d0
         depol(2,i) = 0.0d0
         depol(3,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
                  r = sqrt(r2)
                  fik = fi * pchg(kk)
                  rb2 = rborn(i) * rborn(k)
                  expterm = exp(-0.25d0*r2/rb2)
                  fgb = sqrt(r2 + rb2*expterm)
                  e = fik / fgb
                  de = -fik * (r-0.25d0*r*expterm) / fgb**3
c
c     use 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
                     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
                     dtaper = 5.0d0*c5*r4 + 4.0d0*c4*r3
     &                           + 3.0d0*c3*r2 + 2.0d0*c2*r + c1
                     trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4
     &                               + f3*r3 + f2*r2 + f1*r + f0)
                     dtrans = fik * (7.0d0*f7*r6 + 6.0d0*f6*r5
     &                               + 5.0d0*f5*r4 + 4.0d0*f4*r3
     &                             + 3.0d0*f3*r2 + 2.0d0*f2*r + f1)
                     de = e*dtaper + de*taper + dtrans
                     e = e * taper + trans
                  end if
c
c     increment the overall energy and derivative expressions
c
                  if (i .eq. k) then
                     e = 0.5d0 * e
                     epol = epol + e
                  else
                     epol = epol + e
                     de = de / r
                     dedx = de * xr
                     dedy = de * yr
                     dedz = de * zr
                     depol(1,i) = depol(1,i) + dedx
                     depol(2,i) = depol(2,i) + dedy
                     depol(3,i) = depol(3,i) + dedz
                     depol(1,k) = depol(1,k) - dedx
                     depol(2,k) = depol(2,k) - dedy
                     depol(3,k) = depol(3,k) - dedz
c
c     increment the virial for use in pressure computation
c
                     if (isobaric) then
                        virx = virx + xr*dedx
                        viry = viry + yr*dedy
                        virz = virz + zr*dedz
                     end if
                  end if
c
c     increment the total intermolecular energy
c
                  if (molcule(i) .ne. molcule(k)) then
                     einter = einter + 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
                     r = sqrt(r2)
                     fik = fi * pchg(kk)
                     rb2 = rborn(i) * rborn(k)
                     expterm = exp(-0.25d0*r2/rb2)
                     fgb = sqrt(r2 + rb2*expterm)
                     e = fik / fgb
                     de = -fik * (r-0.25d0*r*expterm) / fgb**3
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
                        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
                        dtaper = 5.0d0*c5*r4 + 4.0d0*c4*r3
     &                              + 3.0d0*c3*r2 + 2.0d0*c2*r + c1
                        trans = fik * (f7*r7 + f6*r6 + f5*r5 + f4*r4
     &                                  + f3*r3 + f2*r2 + f1*r + f0)
                        dtrans = fik * (7.0d0*f7*r6 + 6.0d0*f6*r5
     &                                  + 5.0d0*f5*r4 + 4.0d0*f4*r3
     &                                + 3.0d0*f3*r2 + 2.0d0*f2*r + f1)
                        de = e*dtaper + de*taper + dtrans
                        e = e * taper + trans
                     end if
c
c     form the chain rule terms for derivative expressions
c
                     de = de / r
                     dedx = de * xr
                     dedy = de * yr
                     dedz = de * zr
c
c     increment the overall energy and derivative expressions
c
                     if (i .eq. k)  e = 0.5d0 * e
                     epol = epol + e
                     depol(1,i) = depol(1,i) + dedx
                     depol(2,i) = depol(2,i) + dedy
                     depol(3,i) = depol(3,i) + dedz
                     if (i .ne. k) then
                        depol(1,k) = depol(1,k) - dedx
                        depol(2,k) = depol(2,k) - dedy
                        depol(3,k) = depol(3,k) - dedz
                     end if
c
c     increment the total intermolecular energy
c
                     einter = einter + e
c
c     increment the virial for use in pressure computation
c
                     if (isobaric) then
                        virx = virx + xr*dedx
                        viry = viry + yr*dedy
                        virz = virz + zr*dedz
                     end if
                  end if
               end do
            end if
         end do
      end do
      return
      end
