c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine ebond2  --  atom-by-atom bond stretch Hessian  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "ebond2" calculates second derivatives of the bond
c     stretching energy for a single atom at a time
c
c
      subroutine ebond2 (i)
      implicit none
      include 'sizes.i'
      include 'atmlst.i'
      include 'atoms.i'
      include 'bndpot.i'
      include 'bond.i'
      include 'couple.i'
      include 'group.i'
      include 'hessn.i'
      integer i,j,k,m,ibond
      real*8 ideal,force,fgrp
c jcc real*8 dt,dt2,expterm,bde
      real*8 dt,dt2,expterm,bondde,disoc,alpha,alpha2
      real*8 xr,yr,zr,rik,rik2
      real*8 term,termx,termy,termz
      real*8 de,deddt,d2eddt2,d2e(3,3)
      logical proceed
      logical usebde
c
c
c     compute the Hessian elements of the bond stretch energy
c
      do m = 1, n12(i)
         ibond = bndlist(m,i)
         if (ibnd(1,ibond) .eq. i) then
            k = ibnd(2,ibond)
         else
            k = ibnd(1,ibond)
         end if
         ideal = bl(ibond)
         force = bk(ibond)
c jcc
         bondde = bde(ibond)
         usebde=.false.
         if (bondde.gt.0.0d0) usebde=.true.
c
c     decide whether to compute the current interaction
c
         proceed = .true.
         if (use_group)  call groups (proceed,fgrp,2,i,k,0,0,0)
c
c     compute the value of the bond length deviation
c
         if (proceed) then
            xr = x(i) - x(k)
            yr = y(i) - y(k)
            zr = z(i) - z(k)
            rik2 = xr*xr + yr*yr + zr*zr
            rik = sqrt(rik2)
            dt = rik - ideal
c
c     Morse potential; energy = BDE * (1 - e**(-alpha*dt))**2)
c     with alpha = sqrt(ForceConst/BDE)
c     and BDE = Bond Dissociation Energy
c     If BDE is not given alpha = 2
c
c jcc       if (bndtyp .eq. 'MORSE') then
            if ((bndtyp .eq. 'MORSE').or.(usebde)) then
               if (usebde) then
                  disoc = bondde * bdeunit
                  alpha = sqrt(force*bndunit/disoc)
                  alpha2 = alpha*alpha
               else
                  alpha = 2.d0
                  alpha2 = alpha*alpha
                  disoc = bndunit * force / alpha2
               endif
               expterm = exp(-alpha*dt)
               deddt = 2.0d0 * alpha * disoc * (1.0d0-expterm) * 
     &                 expterm
               d2eddt2 = -2.0d0 * disoc * alpha2
     &                      * (1.0d0-2.0d0*expterm) * expterm
c
c     Taylor series expansion of Morse potential through
c     the fourth power of the bond length deviation
c
            else
               dt2 = dt * dt
               deddt = 2.0d0 * bndunit * force * dt
     &                    * (1.0d0+1.5d0*cbnd*dt+2.0d0*qbnd*dt2)
               d2eddt2 = 2.0d0 * bndunit * force
     &                      * (1.0d0+3.0d0*cbnd*dt+6.0d0*qbnd*dt2)
            end if
c
c     scale the interaction based on its group membership
c
            if (use_group) then
               deddt = deddt * fgrp
               d2eddt2 = d2eddt2 * fgrp
            end if
c
c     set the chain rule terms for the Hessian elements
c
            if (rik2 .eq. 0.0d0) then
               de = 0.0d0
               term = 0.0d0
            else
               de = deddt / rik
               term = (d2eddt2-de) / rik2
            end if
            termx = term * xr
            termy = term * yr
            termz = term * zr
            d2e(1,1) = termx*xr + de
            d2e(1,2) = termx*yr
            d2e(1,3) = termx*zr
            d2e(2,1) = d2e(1,2)
            d2e(2,2) = termy*yr + de
            d2e(2,3) = termy*zr
            d2e(3,1) = d2e(1,3)
            d2e(3,2) = d2e(2,3)
            d2e(3,3) = termz*zr + de
c
c     increment diagonal and non-diagonal Hessian elements
c
            do j = 1, 3
               hessx(j,i) = hessx(j,i) + d2e(1,j)
               hessy(j,i) = hessy(j,i) + d2e(2,j)
               hessz(j,i) = hessz(j,i) + d2e(3,j)
               hessx(j,k) = hessx(j,k) - d2e(1,j)
               hessy(j,k) = hessy(j,k) - d2e(2,j)
               hessz(j,k) = hessz(j,k) - d2e(3,j)
            end do
         end if
      end do
      return
      end
