      subroutine prprsc(rs,sc,iconn,ityp)
      implicit double precision (a-h,o-z), integer (i-n)
      parameter (mxcon=10)
      parameter (mxamb=1590)
      parameter (mxgff=72)
      integer*2 ityp
      common /athlp/  iatoms, mxnat
      common /ambgff/ iambat(mxamb),igffat(mxgff)
      dimension iconn(mxcon+1,*),ityp(*)
      dimension rs(*),sc(*)

      do i=1,iatoms
            itypi = ityp(i)
            if (itypi.lt.0) then
               ia = igffat(itypi)
            else
               ia = iambat(itypi)
            endif
            n = iconn(1,i)
            if (ia.eq.1) then
               rs(i) = 1.25d0
               if (n.ne.0) then
                  k = iconn(2,i)
                  if (ia.eq.7)  rs(i) = 1.15d0
                  if (ia.eq.8)  rs(i) = 1.05d0
               endif
            else if (ia.eq.3) then
               rs(i) = 1.432d0
            else if (ia.eq.6) then
               rs(i) = 1.90d0
               if (n.ne.3) rs(i) = 1.875d0
               if (n.ne.2) rs(i) = 1.825d0
            else if (ia.eq.7) then
               rs(i) = 1.7063d0
               if (n.eq.4)  rs(i) = 1.625d0
               if (n.eq.1)  rs(i) = 1.60d0
            else if (ia.eq.8) then
               rs(i) = 1.535d0
               if (n.eq.1) rs(i) = 1.48d0
            else if (ia.eq.9) then
               rs(i) = 1.47d0
            else if (ia.eq.10) then
               rs(i) = 1.39d0
            else if (ia.eq.11) then
               rs(i) = 1.992d0
            else if (ia.eq.12) then
               rs(i) = 1.70d0
            else if (ia.eq.14) then
               rs(i) = 1.80d0
            else if (ia.eq.15) then
               rs(i) = 1.87d0
            else if (ia.eq.16) then
               rs(i) = 1.775d0
            else if (ia.eq.17) then
               rs(i) = 1.735d0
            else if (ia.eq.18) then
               rs(i) = 1.70d0
            else if (ia.eq.19) then
               rs(i) = 2.123d0
            else if (ia.eq.20) then
               rs(i) = 1.817d0
            else if (ia.eq.35) then
               rs(i) = 1.90d0
            else if (ia.eq.36) then
               rs(i) = 1.812d0
            else if (ia.eq.37) then
               rs(i) = 2.26d0
            else if (ia.eq.53) then
               rs(i) = 2.10d0
            else if (ia.eq.54) then
               rs(i) = 1.967d0
            else if (ia.eq.55) then
               rs(i) = 2.507d0
            else if (ia.eq.56) then
               rs(i) = 2.188d0
            else
               rs(i) = 2.0d0
            end if
      end do

      do i=1,iatoms

          sc(i) = 0.80d0
          itypi = ityp(i)

          if (itypi.lt.0) then
             ia = igffat(itypi)
          else
             ia = iambat(itypi)
          endif

          if (ia.eq.1)   sc(i) = 0.85d0
          if (ia.eq.6)   sc(i) = 0.72d0
          if (ia.eq.7)   sc(i) = 0.79d0
          if (ia.eq.8)   sc(i) = 0.85d0
          if (ia.eq.9)   sc(i) = 0.88d0
          if (ia.eq.15)  sc(i) = 0.86d0
          if (ia.eq.16)  sc(i) = 0.96d0
          if (ia.eq.26)  sc(i) = 0.88d0
      end do

      return
      end

      subroutine born(coo,rs,brad,sc,iconn,ityp)
      implicit double precision (a-h,o-z), integer (i-n)
      parameter (mxcon=10)
      common /athlp/  iatoms, mxnat
      integer*2 ityp
      dimension coo(3,*),iconn(mxcon+1,*),ityp(*)
      dimension rs(*),brad(*),sc(*),vr(3)

      call prprsc(rs,sc,iconn,ityp)

      do i=1,iatoms
         rs(i) = rs(i) - 0.09d0
      end do

c calculate born radii, HTC scheme

      do i=1,iatoms

            ri = rs(i)
            sum = 1.0d0 / ri

            do k=1,iatoms

               if (i.ne.k) then

                  do j=1,3
                     vr(j) = coo(j,k) - coo(j,i)
                  end do

                  r2 = vr(1)*vr(1) + vr(2)*vr(2) + vr(3)*vr(3)

                  r = dsqrt(r2)
                  rk = rs(k)
                  sk = rk*sc(k)
                  sk2 = sk*sk

                  if (ri.lt.r+sk) then
                     dl = 1.0d0 / dble(max(ri,r-sk))
                     du = 1.0d0 / (r+sk)
                     dl2 = dl * dl
                     du2 = du * du
                     term = dl - du + 0.25d0*r*(du2-dl2)
     &                         + (0.5d0/r)*dlog(du/dl)
     &                         + (0.25d0*sk2/r)*(dl2-du2)
                     sum = sum - 0.5d0*term
                  end if

               end if

            end do

            brad(i) = 1.0d0 / sum
            brad(i) = dble(max(ri,brad(i)))

      end do

      return
      end

      subroutine esolv(coo,forces,drb,rs,brad,sc,q,
     &                 iconn,ityp)
c calculate born solvation
      implicit double precision (a-h,o-z), integer (i-n)
      parameter (mxcon=10)
      common /athlp/  iatoms, mxnat
      integer*2 ityp
      dimension coo(3,*),iconn(mxcon+1,*),ityp(*)
      dimension forces(3,*),q(*),drb(*)
      dimension rs(*),brad(*),sc(*)

      es = 0.0d0
      do i = 1, iatoms
         drb(i) = 0.0d0
      end do

c calculate rs, brad and sc

      call born(coo,rs,brad,sc,iconn,ityp)

      term = 16.0d0*datan(1.d0)

      do i = 1, iatoms

c do we have to use + 0.09 here, doffset ??

          ri = rs(i) + 0.09d0
          rb = brad(i)
          if (rb .ne. 0.0d0) then
             e = 0.0054d0 * term * (ri+1.4d0)**2 * (ri/rb)**6
             es = es + e
             drb(i) = drb(i) - 6.0d0*e/rb
          end if
      end do

      call egbsa(coo,forces,drb,q,brad)

      call bself(coo,forces,drb,rs,brad,sc)

      return
      end

      subroutine egbsa(coo,forces,drb,q,brad)
      implicit double precision (a-h,o-z), integer (i-n)
      common /athlp/  iatoms, mxnat
      dimension coo(3,*),forces(3,*),q(*),drb(*),vr(3),ded(3)
      dimension brad(*)

      dwater = 78.3d0
      f = -332.05382d0 * (1.0d0 - 1.0d0/dwater)

      do i=1,iatoms

         fi = f * q(i)
         rbi = brad(i)

         do k=i,iatoms

               do j=1,3
                  vr(j) = coo(j,i) - coo(j,k)
               end do
               r2 = vr(1)*vr(1) + vr(2)*vr(2) + vr(3)*vr(3)

               r = dsqrt(r2)
               rbk = brad(k)
               fik = fi * q(k)
               rb2 = rbi * rbk
               ex = dexp(-0.25d0*r2/rb2)
               fgb2 = r2 + rb2*ex
               fgb = dsqrt(fgb2)
               e = fik / fgb
               de = -e * (r-0.25d0*r*ex) / fgb2
               derb = -e * ex*(0.5d0+0.125d0*r2/rb2) / fgb2

c should this happen ??

               if (i.eq.k) then

                  e = 0.5d0 * e
                  es = es + e
                  drbi = derb * rbk
                  drb(i) = drb(i) + drbi

               else

                  es = es + e
                  de = de / r

                  do j=1,3
                     ded(j) = de * vr(j)
                     forces(j,i) = forces(j,i) + ded(j)
                     forces(j,k) = forces(j,k) - ded(j)
                  end do

                  drbi = derb * rbk
                  drbk = derb * rbi
                  drb(i) = drb(i) + drbi
                  drb(k) = drb(k) + drbk

               end if

         end do
      end do

      return
      end

      subroutine bself(coo,forces,drb,rs,brad,sc)
      implicit double precision (a-h,o-z), integer (i-n)
      common /athlp/  iatoms, mxnat
      dimension coo(3,*),forces(3,*),drb(*),ded(3),vr(3)
      dimension rs(*),brad(*),sc(*)

      do i =1,iatoms

         ri = rs(i)
         rb2 = brad(i) * brad(i)

         do k =1,iatoms

               if (k.ne.i) then

                  do j=1,3
                     vr(j) = coo(j,k) - coo(j,i)
                  end do

                  rk = rs(k)
                  sk = rk * sc(k)
                  sk2 = sk * sk
                  r2 = vr(1)*vr(1) + vr(2)*vr(2) + vr(3)*vr(3)
                  r = dsqrt(r2)

                  if (ri.lt.r+sk) then

                     dl = 1.0d0 / dble(max(ri,r-sk))
                     du = 1.0d0 / (r+sk)
                     dl2 = dl * dl
                     du2 = du * du
                     dl3 = dl * dl2
                     du3 = du * du2

                     fac = 1.0d0
                     if (ri.ge.r-sk) fac = 0.0d0

                     t1 = 0.5d0*dl2 + 0.25d0*sk2*dl3/r
     &                       - 0.25d0*(dl/r+dl3*r)
                     t2 = -0.5d0*du2 - 0.25d0*sk2*du3/r
     &                       + 0.25d0*(du/r+du3*r)
                     t3 = 0.125d0*(1.0d0+sk2/r2)*(dl2-du2)
     &                       + 0.25d0*dlog(du/dl)/r2
                     de = drb(i) * rb2 * (fac*t1+t2+t3) / r

                     do j=1,3
                        ded(j) = de * vr(j)
                     end do

                     do j=1,3
                        forces(j,i) = forces(j,i) + ded(j)
                        forces(j,k) = forces(j,k) - ded(j)
                     end do

                  end if
               end if
          end do
      end do

      return
      end
