c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  program newton  --  perform TNCG Cartesian optimization  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "newton" performs an energy minimization in Cartesian
c     coordinate space using a truncated Newton method
c
c
      program newton
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'files.i'
      include 'iounit.i'
      include 'usage.i'
      integer i,j,imin,nvar,freeunit
      real*8 newton1,minimum,gnorm,grms,grdmin
      real*8 xx(maxvar),derivs(3,maxatm)
      character*1 answer
      character*6 mode,method
      character*60 minfile
      character*80 string
      logical exist
      external newton1,newton2,writeout
c
c
c     set up the structure and mechanics calculation
c
      call initial
      call getxyz
      call mechanic
c
c     get the type of optimization algorithm to use
c
      mode = 'auto  '
      call nextarg (answer,exist)
      if (.not. exist) then
         answer = 'A'
         write (iout,10)  answer
   10    format (/,' Choose Automatic, Newton, TNCG or DTNCG',
     &              ' Method [',a1,'] :  ',$)
         read (input,20)  answer
   20    format (a1)
      end if
      call upcase (answer)
      if (answer .eq. 'A')  mode = 'auto  '
      if (answer .eq. 'N')  mode = 'newton'
      if (answer .eq. 'T')  mode = 'tncg  '
      if (answer .eq. 'D')  mode = 'dtncg '
c
c     get the type of linear equation preconditioning to use
c
      method = 'auto  '
      call nextarg (answer,exist)
      if (.not. exist) then
         answer = 'A'
         write (iout,30)  answer
   30    format (/,' Precondition via Auto/None/Diag/',
     &              'Block/SSOR/ICCG [',a1,'] :  ',$)
         read (input,40)  answer
   40    format (a1)
      end if
      call upcase (answer)
      if (answer .eq. 'A')  method = 'auto  '
      if (answer .eq. 'N')  method = 'none  '
      if (answer .eq. 'D')  method = 'diag  '
      if (answer .eq. 'B')  method = 'block '
      if (answer .eq. 'S')  method = 'ssor  '
      if (answer .eq. 'I')  method = 'iccg  '
c
c     get the termination criterion as RMS gradient per atom
c
      grdmin = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=50,end=50)  grdmin
   50 continue
      if (grdmin .le. 0.0d0) then
         write (iout,60)
   60    format (/,' Enter RMS Gradient per Atom Criterion',
     &              ' [0.01] :  ',$)
         read (input,70)  grdmin
   70    format (f20.0)
      end if
      if (grdmin .le. 0.0d0)  grdmin = 0.01d0
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     translate the coordinates of each active atom
c
      nvar = 0
      do i = 1, n
         if (use(i)) then
            nvar = nvar + 1
            xx(nvar) = x(i)
            nvar = nvar + 1
            xx(nvar) = y(i)
            nvar = nvar + 1
            xx(nvar) = z(i)
         end if
      end do
c
c     make the call to the optimization routine
c
      call tncg (mode,method,nvar,xx,minimum,grdmin,
     &               newton1,newton2,writeout)
c
c     untranslate the final coordinates for active atoms
c
      nvar = 0
      do i = 1, n
         if (use(i)) then
            nvar = nvar + 1
            x(i) = xx(nvar)
            nvar = nvar + 1
            y(i) = xx(nvar)
            nvar = nvar + 1
            z(i) = xx(nvar)
         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,80)  minimum,grms,gnorm
   80    format (/,' Final Function Value :',f15.4,
     &           /,' Final RMS Gradient :  ',f15.4,
     &           /,' Final Gradient Norm : ',f15.4)
      else
         write (iout,90)  minimum,grms,gnorm
   90    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 newton1  --  energy/gradient values for newton  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "newton1" is a service routine that computes the energy
c     and gradient for truncated Newton optimization in Cartesian
c     coordinate space
c
c
      function newton1 (xx,g)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'usage.i'
      integer i,nvar
      real*8 newton1,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
         if (use(i)) then
            nvar = nvar + 1
            x(i) = xx(nvar)
            nvar = nvar + 1
            y(i) = xx(nvar)
            nvar = nvar + 1
            z(i) = xx(nvar)
         end if
      end do
c
c     compute and store the energy and gradient
c
      call gradient (e,derivs)
      newton1 = 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)
            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 if
      end do
      return
      end
c
c
c     #########################################################
c     ##                                                     ##
c     ##  subroutine newton2  --  Hessian values for newton  ##
c     ##                                                     ##
c     #########################################################
c
c
c     "newton2" is a service routine that computes the sparse
c     matrix Hessian elements for truncated Newton optimization
c     in Cartesian coordinate space
c
c
      subroutine newton2 (mode,xx,h,hinit,hstop,hindex,hdiag)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'usage.i'
      integer i,j,k,nvar
      integer hinit(maxvar),hstop(maxvar)
      integer hindex(maxhess)
      integer hvar(maxvar),huse(maxvar)
      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
         if (use(i)) then
            nvar = nvar + 1
            x(i) = xx(nvar)
            nvar = nvar + 1
            y(i) = xx(nvar)
            nvar = nvar + 1
            z(i) = xx(nvar)
         end if
      end do
c
c     compute and store the Hessian elements
c
      call hessian (h,hinit,hstop,hindex,hdiag)
c
c     transform the sparse Hessian to use only active atoms
c
      nvar = 0
      if (nuse .ne. n) then
         do i = 1, n
            k = 3 * (i-1)
            if (use(i)) then
               do j = 1, 3
                  nvar = nvar + 1
                  hvar(nvar) = j + k
                  huse(j+k) = nvar
               end do
            else
               do j = 1, 3
                  huse(j+k) = 0
               end do
            end if
         end do
         do i = 1, nvar
            k = hvar(i)
            hinit(i) = hinit(k)
            hstop(i) = hstop(k)
            hdiag(i) = hdiag(k)
            do j = hinit(i), hstop(i)
               hindex(j) = huse(hindex(j))
            end do
         end do
      end if
c
c     translate the coordinates of each active atom;
c     this 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)
            nvar = nvar + 1
            xx(nvar) = y(i)
            nvar = nvar + 1
            xx(nvar) = z(i)
         end if
      end do
      return
      end
