c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine egeom3  --  restraint energy terms & analysis  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "egeom3" calculates the energy due to restraints on atomic
c     positions, interatomic distances, dihedral angles and Gaussian
c     weighted molecular size; also partitions energy among the atoms
c
c
      subroutine egeom3
      implicit none
      include 'sizes.i'
      include 'action.i'
      include 'analyz.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bound.i'
      include 'energi.i'
      include 'inform.i'
      include 'iounit.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 header,huge,intermol
c
c
c     zero out the restraint energy and partitioning terms
c
      neg = 0
      eg = 0.0d0
      do i = 1, n
         aeg(i) = 0.0d0
      end do
c
c     compute the pseudoenergy for position restraints
c
      header = .true.
      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
            neg = neg + 1
            eg = eg + e
            aeg(i) = aeg(i) + e
            huge = (e .gt. 10.0d0)
            if (debug .or. (verbose.and.huge)) then
               if (header) then
                  header = .false.
                  write (iout,10)
   10             format (/,' Individual Atomic Position Restraint',
     &                       ' Terms :',
     &                    //,' Type',6x,'Atom Name',11x,'Target',
     &                       ' Position',7x,'Distance',6x,'Energy',/)
               end if
               dt = sqrt(dt2)
               write (iout,20)  i,name(i),xpfix(j),ypfix(j),
     &                          zpfix(j),dt,e
   20          format (' Position ',i5,'-',a3,2x,4f10.4,f12.4)
            end if
         end if
      end do
c
c     compute the pseudoenergy for distance restraints
c
      header = .true.
      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
            neg = neg + 1
            eg = eg + e
            aeg(i) = aeg(i) + 0.5d0*e
            aeg(k) = aeg(k) + 0.5d0*e
            huge = (e .gt. 10.0d0)
            if (debug .or. (verbose.and.huge)) then
               if (header) then
                  header = .false.
                  write (iout,30)
   30             format (/,' Individual Interatomic Distance',
     &                       ' Restraint Terms :',
     &                    //,' Type',11x,'Atom Names',20x,'Ideal',
     &                       4x,'Actual',6x,'Energy',/)
               end if
               write (iout,40)  i,name(i),k,name(k),target,rik,e
   40          format (' Distance ',i5,'-',a3,1x,i5,'-',a3,
     &                    12x,2f10.4,f12.4)
            end if
         end if
      end do
c
c     compute the pseudoenergy for dihedral angle restraints
c
      header = .true.
      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
               neg = neg + 1
               eg = eg + e
               aeg(ib) = aeg(ib) + 0.5d0*e
               aeg(ic) = aeg(ic) + 0.5d0*e
               huge = (e .gt. 10.0d0)
               if (debug .or. (verbose.and.huge)) then
                  if (header) then
                     header = .false.
                     write (iout,50)
   50                format (/,' Individual Dihedral Angle Restraint',
     &                          ' Terms :',
     &                       //,' Type',10x,'Atom Numbers',19x,'Ideal',
     &                          4x,'Actual',6x,'Energy',/)
                  end if
                  write (iout,60)  ia,ib,ic,id,target,angle,e
   60             format (' Dihedral ',4i5,11x,2f10.4,f12.4)
               end if
            end if
         end if
      end do
c
c     compute the energy for a shallow Gaussian basin restraint
c
      if (use_basin) then
         header = .true.
         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
               neg = neg + 1
               eg = eg + e
               aeg(i) = aeg(i) + 0.5d0*e
               aeg(k) = aeg(k) + 0.5d0*e
               huge = (e .gt. 10.0d0)
               if (debug .or. (verbose.and.huge)) then
                  if (header) then
                     header = .false.
                     write (iout,70)
   70                format (/,' Individual Gaussian Basin',
     &                          ' Restraint Terms :',
     &                       //,' Type',11x,'Atom Names',20x,'Ideal',
     &                          4x,'Actual',6x,'Energy',/)
                  end if
                  rik = sqrt(rik2)
                  write (iout,80)  i,name(i),k,name(k),0.0d0,rik,e
   80             format (' Distance ',i5,'-',a3,1x,i5,'-',a3,
     &                       12x,2f10.4,f12.4)
               end if
            end do
         end do
      end if
c
c     compute the energy for a spherical droplet boundary restraint
c
      if (use_wall) then
         header = .true.
         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
            neg = neg + 1
            eg = eg + e
            aeg(i) = aeg(i) + e
            huge = (e .gt. 10.0d0)
            if (debug .or. (verbose.and.huge)) then
               if (header) then
                  header = .false.
                  write (iout,90)
   90             format (/,' Individual Spherical Boundary',
     &                       ' Restraint Terms :',
     &                    //,' Type',11x,'Atom Name',28x,'Distance',
     &                       6x,'Energy',/)
               end if
               write (iout,100)  i,name(i),ri,e
  100          format (' Wall',10x,i5,'-',a3,27x,f10.4,f12.4)
            end if
         end do
      end if
      return
      end
