c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1995  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine eopbend2  --  out-of-plane bend Hessian; numer  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "eopbend2" calculates second derivatives of the out-of-plane
c     bend energy as per Allinger's MM forcefields for a single
c     atom using finite difference methods
c
c
      subroutine eopbend2 (i)
      implicit none
      include 'sizes.i'
      include 'angle.i'
      include 'atoms.i'
      include 'deriv.i'
      include 'group.i'
      include 'hessn.i'
      include 'opbend.i'
      integer i,j,k,iopbend
      integer ia,ib,ic,id
      real*8 eps,fgrp,old,term
      real*8 d0(3,maxatm)
      logical proceed
c
c
c     set stepsize for derivatives and default group weight
c
      eps = 1.0d-7
      fgrp = 1.0d0
c
c     compute numerical out-of-plane Hessian for current atom
c
      do iopbend = 1, nopbend
         k = iopb(iopbend)
         ia = iang(1,k)
         ib = iang(2,k)
         ic = iang(3,k)
         id = iang(4,k)
c
c     decide whether to compute the current interaction
c
         proceed = .true.
         if (use_group)  call groups (proceed,fgrp,4,ia,ib,ic,id,0)
         if (proceed)  proceed = (i.eq.ia .or. i.eq.ib .or.
     &                              i.eq.ic .or. i.eq.id)
c
c     find first derivatives for the base structure
c
         if (proceed) then
            term = fgrp / eps
            call eopbend2b (iopbend)
            do j = 1, 3
               d0(j,ia) = deopb(j,ia)
               d0(j,ib) = deopb(j,ib)
               d0(j,ic) = deopb(j,ic)
               d0(j,id) = deopb(j,id)
            end do
c
c     find numerical x-components via perturbed structures
c
            old = x(i)
            x(i) = x(i) + eps
            call eopbend2b (iopbend)
            x(i) = old
            do j = 1, 3
               hessx(j,ia) = hessx(j,ia) + term*(deopb(j,ia)-d0(j,ia))
               hessx(j,ib) = hessx(j,ib) + term*(deopb(j,ib)-d0(j,ib))
               hessx(j,ic) = hessx(j,ic) + term*(deopb(j,ic)-d0(j,ic))
               hessx(j,id) = hessx(j,id) + term*(deopb(j,id)-d0(j,id))
            end do
c
c     find numerical y-components via perturbed structures
c
            old = y(i)
            y(i) = y(i) + eps
            call eopbend2b (iopbend)
            y(i) = old
            do j = 1, 3
               hessy(j,ia) = hessy(j,ia) + term*(deopb(j,ia)-d0(j,ia))
               hessy(j,ib) = hessy(j,ib) + term*(deopb(j,ib)-d0(j,ib))
               hessy(j,ic) = hessy(j,ic) + term*(deopb(j,ic)-d0(j,ic))
               hessy(j,id) = hessy(j,id) + term*(deopb(j,id)-d0(j,id))
            end do
c
c     find numerical z-components via perturbed structures
c
            old = z(i)
            z(i) = z(i) + eps
            call eopbend2b (iopbend)
            z(i) = old
            do j = 1, 3
               hessz(j,ia) = hessz(j,ia) + term*(deopb(j,ia)-d0(j,ia))
               hessz(j,ib) = hessz(j,ib) + term*(deopb(j,ib)-d0(j,ib))
               hessz(j,ic) = hessz(j,ic) + term*(deopb(j,ic)-d0(j,ic))
               hessz(j,id) = hessz(j,id) + term*(deopb(j,id)-d0(j,id))
            end do
         end if
      end do
      return
      end
c
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine eopbend2b  --  out-of-plane bend derivatives  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "eopbend2b" calculates out-of-plane bending first derivatives
c     for a single angle with respect to Cartesian coordinates;
c     used in computation of finite difference second derivatives
c
c
      subroutine eopbend2b (i)
      implicit none
      include 'sizes.i'
      include 'angle.i'
      include 'angpot.i'
      include 'atoms.i'
      include 'deriv.i'
      include 'math.i'
      include 'opbend.i'
      integer i,k,ia,ib,ic,id
      real*8 angle,dot,cosine
      real*8 dt,dt2,dt3,dt4
      real*8 deddt,termb,termp,term
      real*8 xia,yia,zia
      real*8 xib,yib,zib
      real*8 xic,yic,zic
      real*8 xid,yid,zid
      real*8 xad,yad,zad
      real*8 xbd,ybd,zbd,rbd2
      real*8 xcd,ycd,zcd
      real*8 xpd,ypd,zpd,rpd2
      real*8 xt,yt,zt,rt2,ptrt2
      real*8 xm,ym,zm,rm,delta,delta2
      real*8 dedxia,dedyia,dedzia
      real*8 dedxib,dedyib,dedzib
      real*8 dedxic,dedyic,dedzic
      real*8 dedxid,dedyid,dedzid
      real*8 dedxip,dedyip,dedzip
      real*8 dpdxia,dpdyia,dpdzia
      real*8 dpdxic,dpdyic,dpdzic
c
c
c     set the coordinates of the involved atoms
c
      k = iopb(i)
      ia = iang(1,k)
      ib = iang(2,k)
      ic = iang(3,k)
      id = iang(4,k)
      xia = x(ia)
      yia = y(ia)
      zia = z(ia)
      xib = x(ib)
      yib = y(ib)
      zib = z(ib)
      xic = x(ic)
      yic = y(ic)
      zic = z(ic)
      xid = x(id)
      yid = y(id)
      zid = z(id)
c
c     zero out the first derivative components
c
      deopb(1,ia) = 0.0d0
      deopb(2,ia) = 0.0d0
      deopb(3,ia) = 0.0d0
      deopb(1,ib) = 0.0d0
      deopb(2,ib) = 0.0d0
      deopb(3,ib) = 0.0d0
      deopb(1,ic) = 0.0d0
      deopb(2,ic) = 0.0d0
      deopb(3,ic) = 0.0d0
      deopb(1,id) = 0.0d0
      deopb(2,id) = 0.0d0
      deopb(3,id) = 0.0d0
c
c     compute the out-of-plane bending angle
c
      xad = xia - xid
      yad = yia - yid
      zad = zia - zid
      xbd = xib - xid
      ybd = yib - yid
      zbd = zib - zid
      xcd = xic - xid
      ycd = yic - yid
      zcd = zic - zid
      xt = yad*zcd - zad*ycd
      yt = zad*xcd - xad*zcd
      zt = xad*ycd - yad*xcd
      rt2 = xt*xt + yt*yt + zt*zt
      delta = -(xt*xbd + yt*ybd + zt*zbd) / rt2
      xpd = xbd + xt*delta
      ypd = ybd + yt*delta
      zpd = zbd + zt*delta
      rbd2 = xbd*xbd + ybd*ybd + zbd*zbd
      rpd2 = xpd*xpd + ypd*ypd + zpd*zpd
      xm = ypd*zbd - zpd*ybd
      ym = zpd*xbd - xpd*zbd
      zm = xpd*ybd - ypd*xbd
      rm = sqrt(xm*xm + ym*ym + zm*zm)
      if (rm .ne. 0.0d0) then
         dot = xbd*xpd + ybd*ypd + zbd*zpd
         cosine = dot / sqrt(rbd2*rpd2)
         cosine = min (1.0d0,max(-1.0d0,cosine))
         angle = radian * acos(cosine)
c
c     get the out-of-plane bending master chain rule terms
c
         dt = angle
         dt2 = dt * dt
         dt3 = dt2 * dt
         dt4 = dt2 * dt2
         deddt = angunit * kopb(i) * dt * radian
     &              * (2.0d0 + 3.0d0*cang*dt + 4.0d0*qang*dt2
     &                  + 5.0d0*pang*dt3 + 6.0d0*sang*dt4)
c
c     chain rule terms for first derivative components
c
         termb = -deddt / (rbd2*rm)
         termp = deddt / (rpd2*rm)
         dedxib = termb * (ybd*zm-zbd*ym)
         dedyib = termb * (zbd*xm-xbd*zm)
         dedzib = termb * (xbd*ym-ybd*xm)
         dedxip = termp * (ypd*zm-zpd*ym)
         dedyip = termp * (zpd*xm-xpd*zm)
         dedzip = termp * (xpd*ym-ypd*xm)
c
c     chain rule components for the projection of the central atom
c
         delta2 = 2.0d0 * delta
         ptrt2 = (dedxip*xt + dedyip*yt + dedzip*zt) / rt2
         term = (zcd*ybd-ycd*zbd) + delta2*(yt*zcd-zt*ycd)
         dpdxia = delta*(ycd*dedzip-zcd*dedyip) + term*ptrt2
         term = (xcd*zbd-zcd*xbd) + delta2*(zt*xcd-xt*zcd)
         dpdyia = delta*(zcd*dedxip-xcd*dedzip) + term*ptrt2
         term = (ycd*xbd-xcd*ybd) + delta2*(xt*ycd-yt*xcd)
         dpdzia = delta*(xcd*dedyip-ycd*dedxip) + term*ptrt2
         term = (yad*zbd-zad*ybd) + delta2*(zt*yad-yt*zad)
         dpdxic = delta*(zad*dedyip-yad*dedzip) + term*ptrt2
         term = (zad*xbd-xad*zbd) + delta2*(xt*zad-zt*xad)
         dpdyic = delta*(xad*dedzip-zad*dedxip) + term*ptrt2
         term = (xad*ybd-yad*xbd) + delta2*(yt*xad-xt*yad)
         dpdzic = delta*(yad*dedxip-xad*dedyip) + term*ptrt2
c
c     compute derivative components for this interaction
c
         dedxia = dpdxia
         dedyia = dpdyia
         dedzia = dpdzia
         dedxic = dpdxic
         dedyic = dpdyic
         dedzic = dpdzic
         dedxid = -dedxia - dedxib - dedxic
         dedyid = -dedyia - dedyib - dedyic
         dedzid = -dedzia - dedzib - dedzic
c
c     set the out-of-plane bending derivatives
c
         deopb(1,ia) = dedxia
         deopb(2,ia) = dedyia
         deopb(3,ia) = dedzia
         deopb(1,ib) = dedxib
         deopb(2,ib) = dedyib
         deopb(3,ib) = dedzib
         deopb(1,ic) = dedxic
         deopb(2,ic) = dedyic
         deopb(3,ic) = dedzic
         deopb(1,id) = dedxid
         deopb(2,id) = dedyid
         deopb(3,id) = dedzid
      end if
      return
      end
