c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1996  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine born  --  computation of Born radii for GB/SA  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "born" computes the Born radius of each atom for use with
c     the Macromodel GB/SA solvation model
c
c     literature references :
c
c     W. C. Still, A. Tempczyk, R. C. Hawley and T. Hendrickson,
c     "A Semianalytical Treatment of Solvation for Molecular
c     Mechanics and Dynamics", J. Amer. Chem. Soc., 112, 6127-6129
c     (1990)  (see supplimentary material for details)
c
c     G. D. Hawkins, C. J. Cramer and D. G. Truhlar, "Pairwise Solute
c     Descreening of Solute Charges from a Dielectric Medium", Chem.
c     Phys. Lett., 246, 122-129 (1995)  (approximate method)
c
c
      subroutine born
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'inform.i'
      include 'iounit.i'
      include 'math.i'
      include 'solute.i'
      integer i,k,ncalls,atn
      real*8 area,rold,t
      real*8 shell,fraction
      real*8 inner,outer
      real*8 offset,tinit,ratio
      real*8 total,r(maxatm)
      real*8 xi,yi,zi,dik
      real*8 ri,rk,si,si2,sk,sk2
      real*8 lik,lik2,uik,uik2,term
      real*8 sum(maxatm),fs(maxatm)
      logical done
      data ncalls  / 0 /
      save ncalls
c
c
c     increment the number of calls to this routine
c
      ncalls = ncalls + 1
      if (reborn.eq.0 .or. ncalls.lt.reborn)  return
      ncalls = 0
c
c     get the GB/SA dielectric offset atomic radii
c
      offset = -0.09d0
      do i = 1, n
         r(i) = rsolv(i) + offset
      end do
c
c     get the Born radii by Still's original method
c
      if (n .le. bornmax) then
         tinit = 0.1d0
         ratio = 1.5d0
         do i = 1, n
            t = tinit
            rold = r(i)
            total = 0.0d0
            done = .false.
            dowhile (.not. done)
               r(i) = r(i) + 0.5d0*t
               call surfatom (i,area,r)
               fraction = area / (4.0d0*pi*r(i)**2)
               if (fraction .lt. 0.99d0) then
                  inner = r(i) - 0.5d0*t
                  outer = inner + t
                  shell = 1.0d0/inner - 1.0d0/outer
                  total = total + fraction*shell
                  r(i) = r(i) + 0.5d0*t
                  t = ratio * t
               else
                  inner = r(i) - 0.5d0*t
                  total = total + 1.0d0/inner
                  done = .true.
               end if
            end do
            rborn(i) = 1.0d0 / total
            r(i) = rold
         end do
c
c     set the radii factors for the approximate pairwise method
c
      else
         do i = 1, n
            sum(i) = 1.0d0 / r(i)
            fs(i) = 0.80d0
            atn = atomic(i)
            if (atn .eq. 1)  fs(i) = 0.85d0
            if (atn .eq. 6)  fs(i) = 0.72d0
            if (atn .eq. 7)  fs(i) = 0.79d0
            if (atn .eq. 8)  fs(i) = 0.85d0
            if (atn .eq. 9)  fs(i) = 0.88d0
            if (atn .eq. 15)  fs(i) = 0.86d0
            if (atn .eq. 16)  fs(i) = 0.96d0
         end do
c
c     get the Born radii via the approximate pairwise method
c
         do i = 1, n-1
            xi = x(i)
            yi = y(i)
            zi = z(i)
            ri = r(i)
            si = ri * fs(i)
            si2 = si * si
            do k = i+1, n
               rk = r(k)
               sk = rk * fs(k)
               sk2 = sk * sk
               dik = sqrt((x(k)-xi)**2+(y(k)-yi)**2+(z(k)-zi)**2)
               if (ri .lt. dik+sk) then
                  lik = 1.0d0 / max(ri,dik-sk)
                  uik = 1.0d0 / (dik+sk)
                  lik2 = lik * lik
                  uik2 = uik * uik
                  term = lik - uik + 0.25d0*dik*(uik2-lik2)
     &                      + (0.5d0/dik)*log(uik/lik)
     &                      + (0.25d0*sk2/dik)*(lik2-uik2)
                  sum(i) = sum(i) - 0.5d0*term
               end if
               if (rk .lt. dik+si) then
                  lik = 1.0d0 / max(rk,dik-si)
                  uik = 1.0d0 / (dik+si)
                  lik2 = lik * lik
                  uik2 = uik * uik
                  term = lik - uik + 0.25d0*dik*(uik2-lik2)
     &                      + (0.5d0/dik)*log(uik/lik)
     &                      + (0.25d0*si2/dik)*(lik2-uik2)
                  sum(k) = sum(k) - 0.5d0*term
               end if
            end do
         end do
         do i = 1, n
            rborn(i) = 1.0d0 / sum(i)
            rborn(i) = max(r(i),rborn(i))
         end do
      end if
c
c     write out the Born radius of each atom
c
      if (debug) then
         write (iout,10)
   10    format (/,' Born Radius for each Atom :',/)
         k = 1
         dowhile (k .le. n)
            write (iout,20)  (i,rborn(i),i=k,min(k+4,n))
   20       format (1x,5(i7,f8.3))
            k = k + 5
         end do
      end if
      return
      end
