c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1995  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine eopbend1  --  out-of-plane energy and derivs  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "eopbend1" computes the out-of-plane bend potential
c     energy and the first derivatives at trigonal centers
c     as per Allinger's MM forcefields
c
c
      subroutine eopbend1
      implicit none
      include 'sizes.i'
      include 'angle.i'
      include 'angpot.i'
      include 'atoms.i'
      include 'bath.i'
      include 'deriv.i'
      include 'energi.i'
      include 'group.i'
      include 'math.i'
      include 'opbend.i'
      include 'usage.i'
      include 'virial.i'
      integer i,iopbend
      integer ia,ib,ic,id
      real*8 e,dot,cosine
      real*8 angle,fgrp
      real*8 dt,dt2,dt3,dt4
      real*8 deddt,term
      real*8 termb,termp
      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
      real*8 xab,yab,zab,rab
      real*8 xcb,ycb,zcb,rcb,rdb
      logical proceed
c
c
c     zero out out-of-plane energy and first derivatives
c
      eopb = 0.0d0
      do i = 1, n
         deopb(1,i) = 0.0d0
         deopb(2,i) = 0.0d0
         deopb(3,i) = 0.0d0
      end do
c
c     calculate the out-of-plane bend energy and derivatives
c
      do iopbend = 1, nopbend
         i = iopb(iopbend)
         ia = iang(1,i)
         ib = iang(2,i)
         ic = iang(3,i)
         id = iang(4,i)
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 = (use(ia) .or. use(ib) .or.
     &                              use(ic) .or. use(id))
c
c     get the coordinates of the atoms in the angle
c
         if (proceed) then
            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     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     find the out-of-plane energy and master chain rule terms
c
               dt = angle
               dt2 = dt * dt
               dt3 = dt2 * dt
               dt4 = dt2 * dt2
               e = angunit * kopb(iopbend) * dt2
     &                * (1.0d0+cang*dt+qang*dt2+pang*dt3+sang*dt4)
               deddt = angunit * kopb(iopbend) * dt * radian
     &                    * (2.0d0 + 3.0d0*cang*dt + 4.0d0*qang*dt2
     &                        + 5.0d0*pang*dt3 + 6.0d0*sang*dt4)
c
c     scale the interaction based on its group membership
c
               if (use_group) then
                  e = e * fgrp
                  deddt = deddt * fgrp
               end if
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     increment the out-of-plane bend energy and gradient
c
               eopb = eopb + e
               deopb(1,ia) = deopb(1,ia) + dedxia
               deopb(2,ia) = deopb(2,ia) + dedyia
               deopb(3,ia) = deopb(3,ia) + dedzia
               deopb(1,ib) = deopb(1,ib) + dedxib
               deopb(2,ib) = deopb(2,ib) + dedyib
               deopb(3,ib) = deopb(3,ib) + dedzib
               deopb(1,ic) = deopb(1,ic) + dedxic
               deopb(2,ic) = deopb(2,ic) + dedyic
               deopb(3,ic) = deopb(3,ic) + dedzic
               deopb(1,id) = deopb(1,id) + dedxid
               deopb(2,id) = deopb(2,id) + dedyid
               deopb(3,id) = deopb(3,id) + dedzid
c
c     increment the virial for use in pressure computation
c
               if (isobaric) then
                  xab = xia - xib
                  yab = yia - yib
                  zab = zia - zib
                  rab = sqrt(xab*xab + yab*yab + zab*zab)
                  xcb = xic - xib
                  ycb = yic - yib
                  zcb = zic - zib
                  rcb = sqrt(xcb*xcb + ycb*ycb + zcb*zcb)
                  rdb = sqrt(rbd2)
                  virx = virx + rab*dedxia + rcb*dedxic + rdb*dedxid
                  viry = viry + rab*dedyia + rcb*dedyic + rdb*dedyid
                  virz = virz + rab*dedzia + rcb*dedzic + rdb*dedzid
               end if
            end if
         end if
      end do
      return
      end
