c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##################################################################
c     ##                                                              ##
c     ##  subroutine lattice  --  setup periodic boundary conditions  ##
c     ##                                                              ##
c     ##################################################################
c
c
c     "lattice" stores the periodic box dimensions, finds angles
c     to be used in computing fractional coordinates, and decides
c     between images and replicates for the boundary conditions
c
c
      subroutine lattice
      implicit none
      include 'sizes.i'
      include 'bound.i'
      include 'boxes.i'
      include 'cell.i'
      include 'charge.i'
      include 'cutoff.i'
      include 'dipole.i'
      include 'inform.i'
      include 'iounit.i'
      include 'math.i'
      integer i,j,k
      integer nxcell,nycell,nzcell
      real*8 xlimit,ylimit,zlimit
      real*8 maximage,maxcut,alpha_cos
c
c
c     set the periodic boundary box axis lengths and angles
c
      if (xbox .eq. 0.0d0) then
         use_bounds = .false.
         use_image = .false.
         use_replica = .false.
         return
      else
         use_bounds = .true.
         use_image = .true.
         if (ybox .eq. 0.0d0)  ybox = xbox
         if (zbox .eq. 0.0d0)  zbox = xbox
         if (alpha .eq. 0.0d0)  alpha = 90.0d0
         if (beta .eq. 0.0d0)  beta = 90.0d0
         if (gamma .eq. 0.0d0)  gamma = 90.0d0
      end if
c
c     set default values for the potential energy cutoffs
c
      if (chgcut.eq.0.0d0 .or. chgcut.ge.1000000.0d0)  chgcut = 10.0d0
      if (dplcut.eq.0.0d0 .or. dplcut.ge.1000000.0d0)  dplcut = 10.0d0
      if (vdwcut.eq.0.0d0 .or. vdwcut.ge.1000000.0d0)  vdwcut = 10.0d0
c
c     determine the general lattice type
c
      if (alpha.eq.90.0d0 .and. beta.eq.90.0d0
     &                    .and. gamma.eq.90.0d0) then
         orthogonal = .true.
         monoclinic = .false.
         triclinic = .false.
      else if (alpha.eq.90.0 .and. gamma.eq.90.0) then
         orthogonal = .false.
         monoclinic = .true.
         triclinic = .false.
      else
         orthogonal = .false.
         monoclinic = .false.
         triclinic = .true.
      end if
c
c     check for use of truncated octahedron
c
      if (octahedron) then
         if (xbox.eq.ybox .and. xbox.eq.zbox .and.
     &       orthogonal) then
            orthogonal = .false.
         else
            octahedron = .false.
            write (iout,10)
   10       format (/,' LATTICE  --  Truncated Octahedron',
     &                 ' Incompatible with Defined Cell')
         end if
      end if
c
c     set the half width values for the periodic box
c
      xbox2 = 0.5d0 * xbox
      ybox2 = 0.5d0 * ybox
      zbox2 = 0.5d0 * zbox
      if (octahedron)  box34 = 0.75d0 * xbox
c
c     set values used in computation of fractional coordinates
c
      if (orthogonal .or. octahedron) then
         alpha_cos = 0.0d0
         beta_sin = 1.0d0
         beta_cos = 0.0d0
         gamma_sin = 1.0d0
         gamma_cos = 0.0d0
         beta_term = 0.0d0
         gamma_term = 1.0d0
      else if (monoclinic) then
         alpha_cos = 0.0d0
         beta_sin = sin(beta/radian)
         beta_cos = cos(beta/radian)
         gamma_sin = 1.0d0
         gamma_cos = 0.0d0
         beta_term = 0.0d0
         gamma_term = beta_sin
      else if (triclinic) then
         alpha_cos = cos(alpha/radian)
         beta_sin = sin(beta/radian)
         beta_cos = cos(beta/radian)
         gamma_sin = sin(gamma/radian)
         gamma_cos = cos(gamma/radian)
         beta_term = (alpha_cos-beta_cos*gamma_cos) / gamma_sin
         gamma_term = sqrt(1.0d0-alpha_cos**2-beta_cos**2-gamma_cos**2
     &                +2.0d0*alpha_cos*beta_cos*gamma_cos) / gamma_sin
      end if
c
c     find the maximum sphere radius inscribed in periodic box
c
      if (orthogonal) then
         xlimit = xbox2
         ylimit = ybox2
         zlimit = zbox2
      else if (monoclinic) then
         xlimit = xbox2 * beta_sin
         ylimit = ybox2
         zlimit = zbox2 * beta_sin
      else if (triclinic) then
         xlimit = xbox2 * beta_sin * gamma_sin
         ylimit = ybox2 * gamma_sin
         zlimit = zbox2 * beta_sin
      else if (octahedron) then
         xlimit = (sqrt(3.0d0)/4.0d0) * xbox
         ylimit = xlimit
         zlimit = xlimit
      end if
      maximage = min(xlimit,ylimit,zlimit)
c
c     use replicate method to handle cutoffs too large for images
c
      maxcut = vdwcut
      if (nion .ne. 0)  maxcut = max(maxcut,chgcut)
      if (ndipole .ne. 0)  maxcut = max(maxcut,dplcut)
      if (maxcut .le. maximage) then
         use_replica = .false.
      else
         use_replica = .true.
      end if
c
c     truncated octahedron cannot use the replicates method
c
      if (octahedron .and. use_replica) then
         write (iout,20)
   20    format (/,' LATTICE  --  Truncated Octahedron',
     &              ' cannot be Replicated')
         call fatal
      end if
c
c     find the number of replicates for orthogonal lattice
c
      nxcell = int(maxcut/xlimit)
      nycell = int(maxcut/ylimit)
      nzcell = int(maxcut/zlimit)
      if (maxcut .gt. nxcell*xlimit)  nxcell = nxcell + 1
      if (maxcut .gt. nycell*ylimit)  nycell = nycell + 1
      if (maxcut .gt. nzcell*zlimit)  nzcell = nzcell + 1
      xcell = nxcell * xbox
      ycell = nycell * ybox
      zcell = nzcell * zbox
c
c     check the total number of replicated unit cells
c
      ncell = nxcell*nycell*nzcell - 1
      if (ncell .gt. maxcell) then
         write (iout,30)
   30    format (/,' LATTICE  --  Increase MAXCELL or Decrease',
     &              ' the Interaction Cutoffs')
         call fatal
      end if
c
c     assign indices to the required cell replicates
c
      ncell = 0
      do k = 0, nzcell-1
         do j = 0, nycell-1
            do i = 0, nxcell-1
               if (k.ne.0 .or. j.ne.0 .or. i.ne.0) then
                  ncell = ncell + 1
                  icell(1,ncell) = i
                  icell(2,ncell) = j
                  icell(3,ncell) = k
               end if
            end do
         end do
      end do
c
c     set the half width values for the full replicated cell
c
      xcell2 = 0.5d0 * xcell
      ycell2 = 0.5d0 * ycell
      zcell2 = 0.5d0 * zcell
c
c     print a message indicating the number of replicates used
c
      if (debug) then
         write (iout,40)  nxcell,nycell,nzcell
   40    format (/,' LATTICE  --  Periodicity using ',i2,' x',i2,
     &              ' x',i2,' Set of Cell Replicates')
      end if
      return
      end
