c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine image  --  pairwise distance of minimum image  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "image" takes the components of pairwise distance between
c     two points in the same or neighboring periodic boxes and
c     converts to the components of the minimum image distance
c
c
      subroutine image (xr,yr,zr,i)
      implicit none
      include 'sizes.i'
      include 'boxes.i'
      include 'cell.i'
      integer i
      real*8 xr,yr,zr
      real*8 xmove,ymove,zmove
      real*8 xfrac,yfrac,zfrac
c
c
c     compute the distance to translate along each cell axis
c
      if (i .eq. 0) then
         xmove = 0.0d0
         ymove = 0.0d0
         zmove = 0.0d0
      else
         xmove = icell(1,i) * xbox
         ymove = icell(2,i) * ybox
         zmove = icell(3,i) * zbox
      end if
c
c     for orthogonal lattice, find the desired image directly
c
      if (orthogonal) then
         xr = xr + xmove
         dowhile (xr .gt. xcell2)
            xr = xr - xcell
         end do
         dowhile (xr .lt. -xcell2)
            xr = xr + xcell
         end do
         yr = yr + ymove
         dowhile (yr .gt. ycell2)
            yr = yr - ycell
         end do
         dowhile (yr .lt. -ycell2)
            yr = yr + ycell
         end do
         zr = zr + zmove
         dowhile (zr .gt. zcell2)
            zr = zr - zcell
         end do
         dowhile (zr .lt. -zcell2)
            zr = zr + zcell
         end do
c
c     for monoclinic lattice, convert "xr" and "zr" to
c     fractional coordinates, find desired image and then
c     translate fractional coordinates back to Cartesian
c
      else if (monoclinic) then
         zfrac = zr / beta_sin
         xfrac = xr - zfrac*beta_cos
         xfrac = xfrac + xmove
         dowhile (xfrac .gt. xcell2)
            xfrac = xfrac - xcell
         end do
         dowhile (xfrac .lt. -xcell2)
            xfrac = xfrac + xcell
         end do
         yr = yr + ymove
         dowhile (yr .gt. ycell2)
            yr = yr - ycell
         end do
         dowhile (yr .lt. -ycell2)
            yr = yr + ycell
         end do
         zfrac = zfrac + zmove
         dowhile (zfrac .gt. zcell2)
            zfrac = zfrac - zcell
         end do
         dowhile (zfrac .lt. -zcell2)
            zfrac = zfrac + zcell
         end do
         xr = xfrac + zfrac*beta_cos
         zr = zfrac * beta_sin
c
c     for triclinic lattice, convert pairwise components to
c     fractional coordinates, find desired image and then
c     translate fractional coordinates back to Cartesian
c
      else if (triclinic) then
         zfrac = zr / gamma_term
         yfrac = (yr - zfrac*beta_term) / gamma_sin
         xfrac = xr - yfrac*gamma_cos - zfrac*beta_cos
         xfrac = xfrac + xmove
         dowhile (xfrac .gt. xcell2)
            xfrac = xfrac - xcell
         end do
         dowhile (xfrac .lt. -xcell2)
            xfrac = xfrac + xcell
         end do
         yfrac = yfrac + ymove
         dowhile (yfrac .gt. ycell2)
            yfrac = yfrac - ycell
         end do
         dowhile (yfrac .lt. -ycell2)
            yfrac = yfrac + ycell
         end do
         zfrac = zfrac + zmove
         dowhile (zfrac .gt. zcell2)
            zfrac = zfrac - zcell
         end do
         dowhile (zfrac .lt. -zcell2)
            zfrac = zfrac + zcell
         end do
         xr = xfrac + yfrac*gamma_cos + zfrac*beta_cos
         yr = yfrac*gamma_sin + zfrac*beta_term
         zr = zfrac * gamma_term
c
c     for truncated octahedron, use orthogonal box equations,
c     then perform extra tests to remove corner pieces
c
      else if (octahedron) then
         dowhile (xr .gt. xbox2)
            xr = xr - xbox
         end do
         dowhile (xr .lt. -xbox2)
            xr = xr + xbox
         end do
         dowhile (yr .gt. ybox2)
            yr = yr - ybox
         end do
         dowhile (yr .lt. -ybox2)
            yr = yr + ybox
         end do
         dowhile (zr .gt. zbox2)
            zr = zr - zbox
         end do
         dowhile (zr .lt. -zbox2)
            zr = zr + zbox
         end do
         if (abs(xr)+abs(yr)+abs(zr) .gt. box34) then
            xr = xr - sign(xbox2,xr)
            yr = yr - sign(ybox2,yr)
            zr = zr - sign(zbox2,zr)
         end if
      end if
      return
      end
