c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine egeom  --  geometric restraint energy terms  ##
c     ##                                                          ##
c     ##############################################################
c
c
c     "egeom" calculates the energy due to restraints on atomic
c     positions, interatomic distances, dihedral angles, and
c     Gaussian weighted molecular compactness
c
c
      subroutine egeom
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'bound.i'
      include 'energi.i'
      include 'math.i'
      include 'molcul.i'
      include 'restrn.i'
      include 'usage.i'
      integer i,j,k,ia,ib,ic,id
      real*8 e,xr,yr,zr,rik,rik2,dt,dt2
      real*8 angle,target,force,cosine,sine
      real*8 xt,yt,zt,xu,yu,zu,xtu,ytu,ztu
      real*8 rt2,ru2,rtru,rcb
      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 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 geometric restraint energy terms
c
      eg = 0.0d0
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
            eg = eg + e
         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)
            if (rik .lt. dfix(1,j)) then 
               target = dfix(1,j)
            else if (rik .gt. dfix(2,j)) then
               target = dfix(2,j)
            else
               target = rik
            end if
            force = dfix(3,j)
            dt = rik - target
            dt2 = dt * dt
            e = force * dt2
            eg = eg + e
         end if
      end do
c
c     compute the pseudoenergy for dihedral angle restraints
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
               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
               eg = eg + e
            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) - depth
               eg = eg + e
            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
            eg = eg + e
         end do
      end if
      return
      end
