c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##################################################################
c     ##                                                              ##
c     ##  program sniffer  --  global search via Griewank trajcetory  ##
c     ##                                                              ##
c     ##################################################################
c
c
c     "sniffer" performs a global energy minimization using a
c     descrete version of Griewank's global search trajectory
c
c     literature reference:
c
c     R.A.R. Butler and E.E. Slaminka, "An Evaluation of the Sniffer
c     Global Optimization Algorithm Using Standard Test Functions",
c     Journal of Computational Physics, 99, 28-32 (1993)
c
c
      program sniffer
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'files.i'
      include 'iounit.i'
      include 'output.i'
      include 'scales.i'
      include 'usage.i'
      integer i,j,imin,nvar,nstep,freeunit
      real*8 sniffer1,grms,grdmin,gnorm
      real*8 xmove,xstep,dg,dnorm
      real*8 f,fmin,bias,eps,mu
      real*8 alpha,beta,gamma
      real*8 xx(maxvar),g(maxvar),d(maxvar)
      real*8 minimum,derivs(3,maxatm)
      character*60 minfile
      character*80 string
      logical exist
c
c
c     set up the structure and mechanics calculation
c
      call initial
      call getxyz
      call mechanic
c
c     get termination criterion as RMS gradient per atom
c
      grdmin = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=10,end=10)  grdmin
   10 continue
      if (grdmin .le. 0.0d0) then
         write (iout,20)
   20    format (/,' Enter RMS Gradient per Atom Criterion [1.0] :  ',$)
         read (input,30)  grdmin
   30    format (f20.0)
      end if
      if (grdmin .le. 0.0d0)  grdmin = 1.0d0
c
c     write out a copy of coordinates for later update
c
      imin = freeunit ()
      minfile = filename(1:leng)//'.xyz'
      call version (minfile,'new')
      open (unit=imin,file=minfile,status='new')
      call prtxyz (imin)
      close (unit=imin)
      outfile = minfile
c
c     set scaling parameter for function and derivative values;
c     use square root of median eigenvalue of a typical Hessian
c
      scale = 12.0d0
      coordtype = 'cartesian'
      savecycle = .false.
c
c     scale the coordinates of each active atom
c
      nvar = 0
      do i = 1, n
         if (use(i)) then
            nvar = nvar + 1
            xx(nvar) = x(i) * scale
            nvar = nvar + 1
            xx(nvar) = y(i) * scale
            nvar = nvar + 1
            xx(nvar) = z(i) * scale
         end if
      end do
c
c     set initial values for global optimization parameters
c
      nstep = 0
      eps = 1.0d0
      mu = 0.1d0
      gamma = 5.0d0
      bias = 100.0d0 + dble(nvar/3)
      fmin = sniffer1 (xx,g)
      gnorm = 0.0d0
      do i = 1, nvar
         gnorm = gnorm + g(i)**2
      end do
      gnorm = sqrt(gnorm)
      grms = scale * gnorm / sqrt(dble(nvar/3))
      do i = 1, nvar
         d(i) = -g(i) / gnorm
      end do
c
c     write out the initial status of the optimization
c
      write (iout,40)
   40 format (/,' Nstep',7x,'Fmin',8x,'Grms',7x,'Bias',5x,'Xmove',
     &           6x,'Alpha',5x,'Mu',5x,'Eps')
      write (iout,50)  nstep,fmin,grms,bias
   50 format (/,i6,2f12.4,f11.4)
c
c     increase rms gradient to ensure first step is taken
c
      grms = grdmin + 1.0d0
c
c     start the next optimizer step by moving the variables
c
      dowhile (grms .gt. grdmin)
         nstep = nstep + 1
         beta = mu * bias
         xmove = 0.0d0
         do i = 1, nvar
            xstep = beta * d(i)
            xx(i) = xx(i) + xstep
            xmove = xmove + xstep**2
         end do
         xmove = sqrt(xmove/dble(n)) / scale
c
c     find the function value and store if lowest so far
c
         f = sniffer1 (xx,g)
         if (f .lt. fmin) then
            bias = bias + gamma * (fmin - f)
            fmin = min(f,fmin)
            call writeout (xx,nstep)
         end if
c
c     compute the next position step vector
c
         dg = 0.0d0
         do i = 1, nvar
            dg = dg + d(i) * g(i)
         end do
         alpha = max(0.0d0,1.0d0+(1.0d0+eps)*dg)
         gnorm = 0.0d0
         dnorm = 0.0d0
         do i = 1, nvar
            d(i) = -eps*g(i) + alpha*d(i)
            gnorm = gnorm + g(i)**2
            dnorm = dnorm + d(i)**2
         end do
         gnorm = sqrt(gnorm)
         grms = scale * gnorm / sqrt(dble(nvar/3))
         dnorm = sqrt(dnorm)
         do i = 1, nvar
            d(i) = d(i) / dnorm
         end do
c
c     update the global optimization parameters
c
         eps = 1.001d0 * eps
         mu = 0.5d0*mu + 0.005d0/xmove
         bias = bias / (1.0d0 + 0.03d0*gamma)
c
c     write out the current status of the optimization
c
         write (iout,60)  nstep,f,grms,bias,xmove,alpha,mu,eps
   60    format (i6,2f12.4,f11.4,f9.4,f11.4,2f8.3)
      end do
c
c     unscale the final coordinates for active atoms
c
      nvar = 0
      do i = 1, n
         if (use(i)) then
            nvar = nvar + 1
            x(i) = xx(nvar) / scale
            nvar = nvar + 1
            y(i) = xx(nvar) / scale
            nvar = nvar + 1
            z(i) = xx(nvar) / scale
         end if
      end do
c
c     write out final function value and gradient
c
      call gradient (minimum,derivs)
      gnorm = 0.0d0
      do i = 1, n
         if (use(i)) then
            do j = 1, 3
               gnorm = gnorm + derivs(j,i)**2
            end do
         end if
      end do
      gnorm = sqrt(gnorm)
      grms = gnorm / sqrt(dble(nvar/3))
      if (grms .gt. 0.0001d0) then
         write (iout,70)  minimum,grms,gnorm
   70    format (/,' Final Function Value :',f15.4,
     &           /,' Final RMS Gradient :  ',f15.4,
     &           /,' Final Gradient Norm : ',f15.4)
      else
         write (iout,80)  minimum,grms,gnorm
   80    format (/,' Final Function Value :',f15.4,
     &           /,' Final RMS Gradient :  ',d15.4,
     &           /,' Final Gradient Norm : ',d15.4)
      end if
c
c     write the final coordinates into a file
c
      imin = freeunit ()
      open (unit=imin,file=minfile,status='old')
      rewind (unit=imin)
      call prtxyz (imin)
      close (unit=imin)
      end
c
c
c     ##############################################################
c     ##                                                          ##
c     ##  function sniffer1  --  energy and gradient for sniffer  ##
c     ##                                                          ##
c     ##############################################################
c
c
      function sniffer1 (xx,g)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'scales.i'
      include 'usage.i'
      integer i,nvar
      real*8 sniffer1,e
      real*8 xx(maxvar),g(maxvar)
      real*8 derivs(3,maxatm)
c
c
c     translate optimization parameters to atomic coordinates
c
      nvar = 0
      do i = 1, n
         if (use(i)) then
            nvar = nvar + 1
            x(i) = xx(nvar) / scale
            nvar = nvar + 1
            y(i) = xx(nvar) / scale
            nvar = nvar + 1
            z(i) = xx(nvar) / scale
         end if
      end do
c
c     compute and store the energy and gradient
c
      call gradient (e,derivs)
      sniffer1 = e
c
c     store atom gradients as optimization gradient, also
c     translate the coordinates of each active atom; the
c     latter may be needed when using periodic boundaries
c
      nvar = 0
      do i = 1, n
         if (use(i)) then
            nvar = nvar + 1
            xx(nvar) = x(i) * scale
            g(nvar) = derivs(1,i) / scale
            nvar = nvar + 1
            xx(nvar) = y(i) * scale
            g(nvar) = derivs(2,i) / scale
            nvar = nvar + 1
            xx(nvar) = z(i) * scale
            g(nvar) = derivs(3,i) / scale
         end if
      end do
      return
      end
