c
c
c     ##############################################################
c     ##  COPYRIGHT (C) 1997 by Rohit Pappu & Jay William Ponder  ##
c     ##                   All Rights Reserved                    ##
c     ##############################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  program dem  --  diffusion equation Cartesian optimizer  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "dem" implements the diffusion equation method via energy
c     minimization on a series of smoothed potential energy surfaces
c
c     literature reference :
c
c     J. Kostrowicki and H. A. Scheraga, "Application of the Diffusion
c     Equation Method for Global Optimization to Oligopeptides", Journal
c     of Physical Chemistry, 96, 7442-7449 (1992)
c
c     S. Nakamura, H. Hirose, M. Ikeguchi and J. Doi, "Conformational
c     Energy Minimization Using a Two-Stage Method", Journal of Physical
c     Chemistry, 99, 8374-8378 (1995)
c
c
      program dem
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'files.i'
      include 'iounit.i'
      include 'minima.i'
      include 'molcul.i'
      include 'output.i'
      include 'warp.i'
      integer i,k,ixyz,nvar
      integer npoint,neigen
      integer lext,freeunit
      real*8 minimum,grdmin
      real*8 dem1,deform0
      real*8 ratio,sigmoid
      real*8 xx(maxvar)
      character*1 answer
      character*6 mode,method
      character*7 ext
      character*60 coordfile
      character*80 string
      logical exist,use_doi
      external dem1,dem2,writeout
c
c     set up the structure and mechanics calculation
c
      call initial
      call getxyz
      call mechanic
c
c     set maximum deformation value and disable coordinate dumps
c
      coordtype = 'none'
      deform0 = deform
c
c     get the number of points along the deformation schedule
c
      npoint = -1
      call nextarg (string,exist)
      if (exist)  read (string,*,err=10,end=10)  npoint
   10 continue
      if (npoint .le. 0) then
         write (iout,20)
   20    format(/,' Enter the Number of Steps for the DEM Schedule',
     &             ' [100] :  ',$)
         read (input,30)  npoint
   30    format (i10)
         if (npoint .le. 0)  npoint = 100
      end if
c
c     decide whether to use of the Doi local search procedure
c
      use_doi = .false.
      call nextarg (answer,exist)
      if (.not. exist) then
         write (iout,40)
   40    format(/,' Use a Local Search after each DEM Minimization',
     &             ' [N] :  ',$)
         read (input,50)  answer
   50    format (a1)
      end if
      call upcase (answer)
      if (answer .eq. 'Y')  use_doi = .true.
c
c     get the rotatable bonds for the local search procedure
c
      if (use_doi) then
         call makeint (0)
         call initrot
c
c     get the number of eigenvectors to use for the local search
c
         neigen = -1
         call nextarg (string,exist)
         if (exist)  read (string,*,err=60,end=60)  neigen
   60    continue
         if (neigen .le. 0) then
            write (iout,70)
   70       format(/,' Enter the Number Search Directions for Local',
     &                ' Search [5] :  ',$)
            read (input,80)  neigen
   80       format (i10)
            if (neigen .le. 0)  neigen = 5
         end if
      end if
c
c     get the termination criterion as RMS gradient per atom
c
      grdmin = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=90,end=90)  grdmin
   90 continue
      if (grdmin .le. 0.0d0) then
         write (iout,100)
  100    format (/,' Enter RMS Gradient per Atom Criterion',
     &              ' [0.0001] :  ',$)
         read (input,110)  grdmin
  110    format (f20.0)
      end if
      if (grdmin .le. 0.0d0)  grdmin = 0.0001d0
c
c     perform DEM iteration by looping over smoothed surfaces
c
      do k = 0, 2*npoint
         ratio = 1.0d0 - dble(abs(npoint-k))/dble(npoint)
         if (nmol .eq. 1) then
            deform = deform0 * ratio**3
         else
            deform = deform0 * sigmoid (12.0d0,ratio)
         end if
c
c     translate the coordinates of each atom
c
         nvar = 0
         do i = 1, n
            nvar = nvar + 1
            xx(nvar) = x(i)
            nvar = nvar + 1
            xx(nvar) = y(i)
            nvar = nvar + 1
            xx(nvar) = z(i)
         end do
c
c     make the call to the optimization routine
c
         mode = 'auto  '
         method = 'auto  '
         iprint = 1
         call tncg (mode,method,nvar,xx,minimum,grdmin,
     &                     dem1,dem2,writeout)
c
c     untranslate the final coordinates for each atom
c
         nvar = 0
         do i = 1, n
            nvar = nvar + 1
            x(i) = xx(nvar)
            nvar = nvar + 1
            y(i) = xx(nvar)
            nvar = nvar + 1
            z(i) = xx(nvar)
         end do
c
c     use Doi's local search to explore near the DEM minimum
c
         if (use_doi) then
            if (deform.le.5.0d0 .and. k.ge.npoint)
     &         call doisrch (neigen,minimum)
         end if
c
c     write out final energy function value and smoothing level
c
         write (iout,120)  minimum,deform
  120    format (/,' Final Function Value and Deformation :',2f15.4)
c
c     write the coordinates of the current minimum to a file
c
         lext = 3
         call numeral (k,ext,lext)
         ixyz = freeunit ()
         coordfile = filename(1:leng)//'.'//ext(1:lext)
         call version (coordfile,'new')
         open (unit=ixyz,file=coordfile,status='new')
         call prtxyz (ixyz)
         close (unit=ixyz)
      end do
      end
c
c
c     #########################################################
c     ##                                                     ##
c     ##  function dem1  --  energy/gradient values for DEM  ##
c     ##                                                     ##
c     #########################################################
c
c
c     "dem1" is a service routine that computes the energy
c     and gradient during DEM global optimization in Cartesian
c     coordinate space
c
c
      function dem1 (xx,g)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      integer i,nvar
      real*8 dem1,e,derivs(3,maxatm)
      real*8 xx(maxvar),g(maxvar)
c
c
c     translate optimization parameters to atomic coordinates
c
      nvar = 0
      do i = 1, n
         nvar = nvar + 1
         x(i) = xx(nvar)
         nvar = nvar + 1
         y(i) = xx(nvar)
         nvar = nvar + 1
         z(i) = xx(nvar)
      end do
c
c     compute and store the energy and gradient
c
      call gradient (e,derivs)
      dem1 = e
c
c     store atom gradients as optimization gradient, also
c     translate the coordinates of each atom; the latter
c     may be needed when using periodic boundaries
c
      nvar = 0
      do i = 1, n
         nvar = nvar + 1
         xx(nvar) = x(i)
         g(nvar) = derivs(1,i)
         nvar = nvar + 1
         xx(nvar) = y(i)
         g(nvar) = derivs(2,i)
         nvar = nvar + 1
         xx(nvar) = z(i)
         g(nvar) = derivs(3,i)
      end do
      return
      end
c
c
c     ############################################################
c     ##                                                        ##
c     ##  subroutine dem2  --  Hessian values for use with DEM  ##
c     ##                                                        ##
c     ############################################################
c
c
c     "dem2" is a service routine that computes the sparse
c     matrix Hessian elements during DEM global optimization
c     in Cartesian coordinate space
c
c
      subroutine dem2 (mode,xx,h,hinit,hstop,hindex,hdiag)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      integer i,nvar
      integer hinit(maxvar),hstop(maxvar)
      integer hindex(maxhess)
      real*8 xx(maxvar),hdiag(maxvar),h(maxhess)
      character*4 mode
c
c
c     translate optimization parameters to atomic coordinates
c
      if (mode .eq. 'none')  return
      nvar = 0
      do i = 1, n
         nvar = nvar + 1
         x(i) = xx(nvar)
         nvar = nvar + 1
         y(i) = xx(nvar)
         nvar = nvar + 1
         z(i) = xx(nvar)
      end do
c
c     compute and store the Hessian elements
c
      call hessian (h,hinit,hstop,hindex,hdiag)
c
c     translate the coordinates of each atom; this
c     may be needed when using periodic boundaries
c
      nvar = 0
      do i = 1, n
         nvar = nvar + 1
         xx(nvar) = x(i)
         nvar = nvar + 1
         xx(nvar) = y(i)
         nvar = nvar + 1
         xx(nvar) = z(i)
      end do
      return
      end
c
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine doisrch  --  local search for Cartesian DEM  ##
c     ##                                                          ##
c     ##############################################################
c
c
      subroutine doisrch (neigen,minimum)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'iounit.i'
      include 'omega.i'
      include 'refer.i'
      integer i,k,neigen,ndoi,nsearch
      real*8 minimum,minref,minbest
      real*8 eps,rms,step(maxrot)
      real*8 eigen(maxrot),vects(maxrot,maxrot)
      real*8 xbest(maxatm),ybest(maxatm),zbest(maxatm)
      logical done
c
c
c     store the current coordinates as the reference set
c
      call makeref
c
c     set parameters related to the local search procedure
c
      done = .false.
      eps = 0.0001d0
      minref = minimum
      minbest = minimum
      ndoi = 0
c
c     find local minimum along each of the steepest directions
c
      dowhile (.not. done)
         ndoi = ndoi + 1
         write (iout,10)  ndoi,minref
   10    format (/,' Normal Mode Search :',8x,'Iteration',i4,
     &              5x,'Energy',f12.4,/)
         call makeint (0)
         call eigenrot (eigen,vects)
c
c     search both directions along each eigenvector in turn
c
         nsearch = 0
         do i = 1, neigen
            do k = 1, nomega
               step(k) = vects(k,nomega-i+1)
            end do
            nsearch = nsearch + 1
            call climber (nsearch,minimum,step)
            if (minimum .lt. minbest) then
               minbest = minimum
               do k = 1, n
                  xbest(k) = x(k)
                  ybest(k) = y(k)
                  zbest(k) = z(k)
               end do
            end if
            do k = 1, nomega
               step(k) = -vects(k,nomega-i+1)
            end do
            nsearch = nsearch + 1
            call climber (nsearch,minimum,step)
            if (minimum .lt. minbest) then
               minbest = minimum
               do k = 1, n
                  xbest(k) = x(k)
                  ybest(k) = y(k)
                  zbest(k) = z(k)
               end do
            end if
         end do
c
c     check for convergence of the local search procedure
c
         if (minbest .lt. minref-eps) then
            done = .false.
            minref = minbest
            call impose (n,xref,yref,zref,n,xbest,ybest,zbest,rms)
            do k = 1, n
               x(k) = xbest(k)
               y(k) = ybest(k)
               z(k) = zbest(k)
            end do
            call makeref
         else
            done = .true.
            minimum = minref
            call getref
         end if
      end do
      return
      end
c
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine eigenrot  --  torsional Hessian eigenvectors  ##
c     ##                                                           ##
c     ###############################################################
c
c
      subroutine eigenrot (eigen,vects)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'omega.i'
      integer i,j,ihess
      real*8 hrot(maxrot,maxrot),matrix((maxrot+1)*maxrot/2)
      real*8 a(maxrot+1),b(maxrot+1),p(maxrot+1),ta(maxrot+1)
      real*8 w(maxrot+1),tb(maxrot+1),ty(maxrot+1)
      real*8 vnorm,eigen(maxrot),vects(maxrot,maxrot)
c
c
c     compute the Hessian in torsional space
c
      call hessrot ('full',hrot)
c
c     place Hessian elements into triangular form
c
      ihess = 0
      do i = 1, nomega
         do j = i, nomega
            ihess = ihess + 1
            matrix(ihess) = hrot(i,j)
         end do
      end do
c
c     diagonalize the Hessian to obtain eigenvalues
c
      call diagq (nomega,maxrot,nomega,matrix,eigen,vects,
     &                     a,b,p,w,ta,tb,ty)
c
c     normalize the torsional Hessian eigenvectors
c
      do i = 1, nomega
         vnorm = 0.0d0
         do j = 1, nomega
            vnorm = vnorm + vects(j,i)**2
         end do
         vnorm = sqrt(vnorm)
         do j = 1, nomega
            vects(j,i) = vects(j,i) / vnorm
         end do
      end do
      return
      end
c
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine climber  --  minimum from a DEM local search  ##
c     ##                                                           ##
c     ###############################################################
c
c
      subroutine climber (nsearch,minimum,step)
      implicit none
      include 'sizes.i'
      include 'iounit.i'
      include 'math.i'
      include 'omega.i'
      include 'zcoord.i'
      integer maxstep
      parameter (maxstep=500)
      integer i,kstep,nstep,nsearch
      real*8 minimum,big,energy,size
      real*8 step(maxrot),estep(0:maxstep)
      logical done
c
c
c     convert current reference coordinates to a Z-matrix
c
      call getref
      call makeint (0)
c
c     set the maximum number of steps and the step size
c
      done = .false.
      big = 100000.0d0
      minimum = big
      kstep = 0
      nstep = 65
      size = 0.1d0 * radian
      do i = 1, nomega
         step(i) = size * step(i)
      end do
c
c     scan the search direction for a minimization candidate
c
      dowhile (.not. done)
         if (kstep .ne. 0) then
            do i = 1, nomega
               bet(zline(i)) = bet(zline(i)) + step(i)
            end do
         end if
         call makexyz
         estep(kstep) = energy ()
         if (kstep .ge. 2) then
            if (estep(kstep) .lt. estep(kstep-2) .and.
     &          estep(kstep-1) .lt. estep(kstep-2)) then
               done = .true.
               do i = 1, nomega
                  bet(zline(i)) = bet(zline(i)) - step(i)
               end do
               call makexyz
               call localmin (minimum)
               if (minimum .ge. -big) then
                  write (iout,10)  nsearch,kstep-1,minimum
   10             format (4x,'Search Direction',i4,10x,'Step',
     &                       i4,11x,f12.4)
               else
                  minimum = big
                  write (iout,20)  nsearch
   20             format (4x,'Search Direction',i4,35x,'------')
               end if
            end if
         end if
         if (kstep.ge.nstep .and. .not.done) then
            done = .true.
            write (iout,30)  nsearch
   30       format (4x,'Search Direction',i4,35x,'------')
         end if
         kstep = kstep + 1
      end do
      return
      end
c
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine localmin  --  DEM local search optimization  ##
c     ##                                                          ##
c     ##############################################################
c
c
c     "localmin" is during the the DEM local search procedure
c     to perform a Cartesian coordinate energy minimization
c
c
      subroutine localmin (minimum)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'inform.i'
      include 'minima.i'
      integer i,nvar,oldprt
      real*8 minimum,grdmin
      real*8 dem1,xx(maxvar)
      character*6 mode,method
      logical oldverb
      external dem1,dem2,writeout
c
c
c     translate the coordinates of each atom
c
      nvar = 0
      do i = 1, n
         nvar = nvar + 1
         xx(nvar) = x(i)
         nvar = nvar + 1
         xx(nvar) = y(i)
         nvar = nvar + 1
         xx(nvar) = z(i)
      end do
c
c     make the call to the optimization routine
c
      mode = 'auto  '
      method = 'diag  '
      grdmin = 0.0001d0
      oldverb = verbose
      oldprt = iprint
      verbose = .false.
      iprint = 0
      call tncg (mode,method,nvar,xx,minimum,grdmin,
     &                 dem1,dem2,writeout)
      verbose = oldverb
      iprint = oldprt
c
c     untranslate the final coordinates for each atom
c
      nvar = 0
      do i = 1, n
         nvar = nvar + 1
         x(i) = xx(nvar)
         nvar = nvar + 1
         y(i) = xx(nvar)
         nvar = nvar + 1
         z(i) = xx(nvar)
      end do
      return
      end
