c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #############################################################
c     ##                                                         ##
c     ##  subroutine egeom1  --  restraint energy & derivatives  ##
c     ##                                                         ##
c     #############################################################
c
c
c     "egeom1" calculates the potential energy and first derivatives
c     with respect to Cartesian coordinates for restraints on atom
c     positions, interatomic distances and dihedral angles
c
c
      subroutine egeom1
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'bath.i'
      include 'bound.i'
      include 'deriv.i'
      include 'energi.i'
      include 'inter.i'
      include 'molcul.i'
      include 'math.i'
      include 'restrn.i'
      include 'usage.i'
      include 'virial.i'
      integer i,j,k,ia,ib,ic,id
      real*8 e,xr,yr,zr,rik,rik2
      real*8 de,dedx,dedy,dedz,dt,dt2,deddt
      real*8 angle,target,force,cosine,sine
      real*8 xia,yia,zia,xib,yib,zib
      real*8 xic,yic,zic,xid,yid,zid
      real*8 xba,yba,zba,xcb,ycb,zcb
      real*8 xdc,ydc,zdc
      real*8 xca,yca,zca,xdb,ydb,zdb
      real*8 xt,yt,zt,xu,yu,zu,xtu,ytu,ztu
      real*8 rt2,ru2,rtru,rcb,dedphi
      real*8 dphidxt,dphidyt,dphidzt
      real*8 dphidxu,dphidyu,dphidzu
      real*8 dphidxia,dphidyia,dphidzia
      real*8 dphidxib,dphidyib,dphidzib
      real*8 dphidxic,dphidyic,dphidzic
      real*8 dphidxid,dphidyid,dphidzid
      real*8 dedxia,dedyia,dedzia
      real*8 dedxib,dedyib,dedzib
      real*8 dedxic,dedyic,dedzic
      real*8 dedxid,dedyid,dedzid
      real*8 tf1,tf2,t1,t2
      real*8 xi,yi,zi,ri
      real*8 a,b,buffer
      real*8 r,r2,r6,r12
      logical intermol
c
c
c     zero out the restraint energy term and first derivatives
c
      eg = 0.0d0
      do i = 1, n
         deg(1,i) = 0.0d0
         deg(2,i) = 0.0d0
         deg(3,i) = 0.0d0
      end do
c
c     compute the pseudoenergy for position restraints
c
      do j = 1, npfix
         i = ipfix(j)
         if (use(i)) then
            xr = x(i) - xpfix(j)
            yr = y(i) - ypfix(j)
            zr = z(i) - zpfix(j)
            dt2 = xr*xr + yr*yr + zr*zr
            force = pfix(j)
            e = force * dt2
            deddt = 2.0d0 * force
            dedx = deddt * xr
            dedy = deddt * yr
            dedz = deddt * zr
c
c     increment the total energy and first derivatives
c
            eg = eg + e
            deg(1,i) = deg(1,i) + dedx
            deg(2,i) = deg(2,i) + dedy
            deg(3,i) = deg(3,i) + dedz
c
c     increment the virial for use in pressure computation
c
            if (isobaric) then
               virx = virx + xr*dedx
               viry = viry + yr*dedy
               virz = virz + zr*dedz
            end if
         end if
      end do
c
c     compute the pseudoenergy for distance restraints
c
      do j = 1, ndfix
         i = idfix(1,j)
         k = idfix(2,j)
         if (use(i) .or. use(k)) then
            xr = x(i) - x(k)
            yr = y(i) - y(k)
            zr = z(i) - z(k)
            intermol = (molcule(i) .ne. molcule(k))
            if (use_bounds .and. intermol)  call image (xr,yr,zr,0)
            rik2 = xr*xr + yr*yr + zr*zr
            rik = sqrt(rik2)
            target = rik
            if (rik .lt. dfix(1,j))  target = dfix(1,j)
            if (rik .gt. dfix(2,j))  target = dfix(2,j)
            force = dfix(3,j)
            dt = rik - target
            dt2 = dt * dt
            e = force * dt2
            deddt = 2.0d0 * force * dt
c
c     compute chain rule terms needed for derivatives
c
            de = deddt / rik
            dedx = de * xr
            dedy = de * yr
            dedz = de * zr
c
c     increment the total energy and first derivatives
c
            eg = eg + e
            deg(1,i) = deg(1,i) + dedx
            deg(2,i) = deg(2,i) + dedy
            deg(3,i) = deg(3,i) + dedz
            deg(1,k) = deg(1,k) - dedx
            deg(2,k) = deg(2,k) - dedy
            deg(3,k) = deg(3,k) - dedz
c
c     increment the total intermolecular energy
c
            if (intermol) then
               einter = einter + e
            end if
c
c     increment the virial for use in pressure computation
c
            if (isobaric) then
               virx = virx + xr*dedx
               viry = viry + yr*dedy
               virz = virz + zr*dedz
            end if
         end if
      end do
c
c     compute the pseudoenergy and derivs for dihedral restraints;
c     for each angle we first calculate the cosine and sine of the
c     dihedral between atoms ia-ib-ic-id
c
      do i = 1, ntfix
         ia = itfix(1,i)
         ib = itfix(2,i)
         ic = itfix(3,i)
         id = itfix(4,i)
         if (use(ia) .or. use(ib) .or. use(ic) .or. use(id)) 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)
            xba = xib - xia
            yba = yib - yia
            zba = zib - zia
            xcb = xic - xib
            ycb = yic - yib
            zcb = zic - zib
            xdc = xid - xic
            ydc = yid - yic
            zdc = zid - zic
            xt = yba*zcb - ycb*zba
            yt = zba*xcb - zcb*xba
            zt = xba*ycb - xcb*yba
            xu = ycb*zdc - ydc*zcb
            yu = zcb*xdc - zdc*xcb
            zu = xcb*ydc - xdc*ycb
            xtu = yt*zu - yu*zt
            ytu = zt*xu - zu*xt
            ztu = xt*yu - xu*yt
            rt2 = xt*xt + yt*yt + zt*zt
            ru2 = xu*xu + yu*yu + zu*zu
            rtru = sqrt(rt2 * ru2)
            if (rtru .ne. 0.0d0) then
               rcb = sqrt(xcb*xcb + ycb*ycb + zcb*zcb)
               cosine = (xt*xu + yt*yu + zt*zu) / rtru
               sine = (xcb*xtu + ycb*ytu + zcb*ztu) / (rcb*rtru)
               cosine = min(1.0d0,max(-1.0d0,cosine))
               angle = radian * acos(cosine)
               if (sine .lt. 0.0d0)  angle = -angle
c
c     calculate the pseudoenergy contribution for this angle
c
               tf1 = tfix(1,i)
               tf2 = tfix(2,i)
               if (angle.gt.tf1 .and. angle.lt.tf2) then
                  target = angle
               else if (angle.gt.tf1 .and. tf1.gt.tf2) then
                  target = angle
               else if (angle.lt.tf2 .and. tf1.gt.tf2) then
                  target = angle
               else
                  t1 = angle - tf1
                  t2 = angle - tf2
                  if (t1 .gt. 180.0d0) then
                     t1 = t1 - 360.0d0
                  else if (t1 .lt. -180.0d0) then
                     t1 = t1 + 360.0d0
                  end if
                  if (t2 .gt. 180.0d0) then
                     t2 = t2 - 360.0d0
                  else if (t2 .lt. -180.0d0) then
                     t2 = t2 + 360.0d0
                  end if
                  if (abs(t1) .lt. abs(t2)) then
                     target = tf1
                  else
                     target = tf2
                  end if
               end if
               force = tfix(3,i)
               dt = angle - target
               if (dt .gt. 180.0d0) then
                  dt = dt - 360.0d0
               else if (dt .lt. -180.0d0) then
                  dt = dt + 360.0d0
               end if
               dt2 = dt * dt
               e = force * dt2
               dedphi = 2.0d0 * radian * force * dt
c
c     abbreviations for first derivative chain rule terms
c
               xca = xic - xia
               yca = yic - yia
               zca = zic - zia
               xdb = xid - xib
               ydb = yid - yib
               zdb = zid - zib
               dphidxt = (yt*zcb - ycb*zt) / (rt2*rcb)
               dphidyt = (zt*xcb - zcb*xt) / (rt2*rcb)
               dphidzt = (xt*ycb - xcb*yt) / (rt2*rcb)
               dphidxu = -(yu*zcb - ycb*zu) / (ru2*rcb)
               dphidyu = -(zu*xcb - zcb*xu) / (ru2*rcb)
               dphidzu = -(xu*ycb - xcb*yu) / (ru2*rcb)
c
c     chain rule terms for first derivative components
c
               dphidxia = zcb*dphidyt - ycb*dphidzt
               dphidyia = xcb*dphidzt - zcb*dphidxt
               dphidzia = ycb*dphidxt - xcb*dphidyt
               dphidxib = yca*dphidzt - zca*dphidyt
     &                       + zdc*dphidyu - ydc*dphidzu
               dphidyib = zca*dphidxt - xca*dphidzt
     &                       + xdc*dphidzu - zdc*dphidxu
               dphidzib = xca*dphidyt - yca*dphidxt
     &                       + ydc*dphidxu - xdc*dphidyu
               dphidxic = zba*dphidyt - yba*dphidzt
     &                       + ydb*dphidzu - zdb*dphidyu
               dphidyic = xba*dphidzt - zba*dphidxt
     &                       + zdb*dphidxu - xdb*dphidzu
               dphidzic = yba*dphidxt - xba*dphidyt
     &                       + xdb*dphidyu - ydb*dphidxu
               dphidxid = zcb*dphidyu - ycb*dphidzu
               dphidyid = xcb*dphidzu - zcb*dphidxu
               dphidzid = ycb*dphidxu - xcb*dphidyu
c
c     compute first derivative components for this angle
c
               dedxia = dedphi * dphidxia
               dedyia = dedphi * dphidyia
               dedzia = dedphi * dphidzia
               dedxib = dedphi * dphidxib
               dedyib = dedphi * dphidyib
               dedzib = dedphi * dphidzib
               dedxic = dedphi * dphidxic
               dedyic = dedphi * dphidyic
               dedzic = dedphi * dphidzic
               dedxid = dedphi * dphidxid
               dedyid = dedphi * dphidyid
               dedzid = dedphi * dphidzid
c
c     increment the overall extra energy term and derivatives
c
               eg = eg + e
               deg(1,ia) = deg(1,ia) + dedxia
               deg(2,ia) = deg(2,ia) + dedyia
               deg(3,ia) = deg(3,ia) + dedzia
               deg(1,ib) = deg(1,ib) + dedxib
               deg(2,ib) = deg(2,ib) + dedyib
               deg(3,ib) = deg(3,ib) + dedzib
               deg(1,ic) = deg(1,ic) + dedxic
               deg(2,ic) = deg(2,ic) + dedyic
               deg(3,ic) = deg(3,ic) + dedzic
               deg(1,id) = deg(1,id) + dedxid
               deg(2,id) = deg(2,id) + dedyid
               deg(3,id) = deg(3,id) + dedzid
c
c     increment the total intermolecular energy
c
               if (molcule(ia).ne.molcule(ib) .or.
     &             molcule(ia).ne.molcule(ic) .or.
     &             molcule(ia).ne.molcule(id)) then
                  einter = einter + e
               end if
c
c     increment the virial for use in pressure computation
c
               if (isobaric) then
                  virx = virx - xba*dedxia + xdc*dedxid
     &                      + xcb*(dedxic-dedxid)
                  viry = viry - yba*dedyia + ydc*dedyid
     &                      + ycb*(dedyic-dedyid)
                  virz = virz - zba*dedzia + zdc*dedzid
     &                      + zcb*(dedzic-dedzid)
               end if
            end if
         end if
      end do
c
c     compute the energy for a shallow Gaussian basin restraint
c
      if (use_basin) then
         do i = 1, n-1
            xi = x(i)
            yi = y(i)
            zi = z(i)
            do k = i+1, n
               xr = xi - x(k)
               yr = yi - y(k)
               zr = zi - z(k)
               rik2 = xr*xr + yr*yr + zr*zr
               e = depth * exp(-width*rik2)
               de = -2.0d0 * width * e
               e = e - depth
               dedx = de * xr
               dedy = de * yr
               dedz = de * zr
c
c     increment the total energy and first derivatives
c
               eg = eg + e
               deg(1,i) = deg(1,i) + dedx
               deg(2,i) = deg(2,i) + dedy
               deg(3,i) = deg(3,i) + dedz
               deg(1,k) = deg(1,k) - dedx
               deg(2,k) = deg(2,k) - dedy
               deg(3,k) = deg(3,k) - dedz
c
c     increment the virial for use in pressure computation
c
               if (isobaric) then
                  virx = virx + xr*dedx
                  viry = viry + yr*dedy
                  virz = virz + zr*dedz
               end if
            end do
         end do
      end if
c
c     compute the energy for a spherical droplet boundary restraint
c
      if (use_wall) then
         buffer = 2.5d0
         a = 2048.0d0
         b = 64.0d0
         do i = 1, n
            xi = x(i)
            yi = y(i)
            zi = z(i)
            ri = sqrt(xi**2 + yi**2 + zi**2)
            r = rwall + buffer - ri
            r2 = r * r
            r6 = r2 * r2 * r2
            r12 = r6 * r6
            e = a/r12 - b/r6
            if (ri .eq. 0.0d0)  ri = 1.0d0
            de = (12.0d0*a/r12 - 6.0d0*b/r6) / (r*ri)
            dedx = de * xi
            dedy = de * yi
            dedz = de * zi
c
c     increment the total energy and first derivatives
c
            eg = eg + e
            deg(1,i) = deg(1,i) + dedx
            deg(2,i) = deg(2,i) + dedy
            deg(3,i) = deg(3,i) + dedz
c
c     increment the virial for use in pressure computation
c
            if (isobaric) then
               xr = r * xi/ri
               yr = r * yi/ri
               zr = r * zi/ri
               virx = virx + xr*dedx
               viry = viry + yr*dedy
               virz = virz + zr*dedz
            end if
         end do
      end if
      return
      end
