c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine tncg  --  truncated newton optimization method  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "tncg" implements the truncated Newton optimization algorithm;
c     a linear conjugate gradient method is used to achieve the
c     (truncated) solution of the Newton equations; special features
c     include use of sparse Hessian matrix, various types of linear
c     equation preconditioning, use of the explicit Hessian or a
c     finite-difference gradient approximation within PCG iteration,
c     and optional use of the exact Newton search directions;
c     under default operation, the algorithm checks for directions
c     of negative curvature during the PCG iteration in order to
c     prevent convergence to a stationary point having negative
c     eigenvalues; if optimization to a saddle point is desired
c     this check can be removed by disabling "negtest"
c
c     literature references :
c
c     J. W. Ponder and F. M Richards, "An Efficient Newton-like
c     Method for Molecular Mechanics Energy Minimization of
c     Large Molecules", Journal of Computational Chemistry,
c     8, 1016-1024 (1987)
c
c     R. S. Dembo and T. Steihaug, "Truncated-Newton Algorithms
c     for Large-Scale Unconstrained Optimization", Mathematical
c     Programming, 26, 190-212 (1983)
c
c     variables and parameters :
c
c     mode       determines optimization method; choice of
c                  Newton's method, truncated Newton, or
c                  truncated Newton with finite differencing
c     method     determines which type of preconditioning will
c                  be used on the Newton equations; choice
c                  of none, diagonal, 3x3 block diagonal,
c                  SSOR or incomplete Cholesky preconditioning
c     nvar       number of parameters in the objective function
c     minimum    upon return contains the best value of the
c                  function found during the optimization
c     f          contains current best value of function
c     x          contains starting point upon input, upon
c                  return contains the best point found
c     g          contains gradient of current best point
c     h          contains the Hessian matrix values in an
c                  indexed linear array
c     h_mode     controls amount of Hessian matrix computed;
c                  either the full matrix, diagonal or none
c     h_init     points to the first Hessian matrix element
c                  associated with each parameter
c     h_stop     points to the last Hessian matrix element
c                  associated with each parameter
c     h_index    contains second parameter involved in each
c                  element of the Hessian array
c     h_diag     contains diagonal of the Hessian matrix
c     p          search direction resulting from pcg iteration
c     f_move     function decrease over last tncg iteration
c     f_old      function value at end of last iteration
c     x_move     rms movement per atom over last tn iteration
c     x_old      parameters value at end of last tn iteration
c     g_norm     Euclidian norm of the gradient vector
c     g_rms      root mean square gradient value
c     fg_call    cumulative number of function/gradient calls
c     grdmin     termination criterion based on RMS gradient
c     iprint     print iteration results every iprint iterations
c     iwrite     call user-supplied output every iwrite iterations
c     newhess    number of iterations between the computation
c                  of new Hessian matrix values
c     negtest    determines whether test for negative curvature
c                  is performed during the PCG iterations
c     maxiter    maximum number of tncg iterations to attempt
c
c     parameters used in the line search :
c
c     cappa      accuarcy of line search control  (0 < cappa < 1)
c     stpmin     minimum allowed line search step size
c     stpmax     maximum allowed line search step size
c     angmax     maximum angle between search and -grad directions
c     intmax     maximum number of interpolations in line search
c
c     required external routines :
c
c     fgvalue    function to evaluate function and gradient values
c     hmatrix    subroutine which evaluates Hessian diagonal
c                  and large off-diagonal matrix elements
c     writeout   subroutine to write out info about current status
c
c
      subroutine tncg (mode,method,nvar,x,minimum,grdmin,
     &                     fgvalue,hmatrix,writeout)
      implicit none
      include 'sizes.i'
      include 'hescut.i'
      include 'iounit.i'
      include 'keys.i'
      include 'linmin.i'
      include 'math.i'
      include 'minima.i'
      include 'output.i'
      include 'pistuf.i'
      include 'potent.i'
      include 'solute.i'
      integer i,nvar,fg_call,next
      integer iter_tn,iter_cg,newhess
      integer h_init(maxvar),h_stop(maxvar)
      integer h_index(maxhess)
      real*8 x(maxvar),x_old(maxvar)
      real*8 g(maxvar),p(maxvar)
      real*8 h(maxhess),h_diag(maxvar)
      real*8 minimum,f,fgvalue,grdmin,angle,rms
      real*8 x_move,f_move,f_old,g_norm,g_rms
      character*4 h_mode
      character*6 mode,method
      character*9 status,info_solve,info_search
      character*20 keyword
      character*80 record
      logical done,negtest
      logical automode,automatic
      save h_index,h
      external fgvalue,hmatrix,writeout
c
c
c     check number of variables and get type of optimization
c
      if (nvar .gt. maxvar) then
         write (iout,10)
   10    format (' TNCG  --  Too many Parameters,',
     &           ' Increase value of MAXVAR')
         return
      end if
      rms = sqrt(dble(nvar))
      if (coordtype .eq. 'cartesian') then
         rms = rms / sqrt(3.0d0)
      else if (coordtype .eq. 'rigidbody') then
         rms = rms / sqrt(6.0d0)
      end if
c
c     set default parameters for the optimization
c
      if (fctmin .eq. 0.0d0)  fctmin = -1000000.0d0
      if (iwrite .lt. 0)  iwrite = 1
      if (iprint .lt. 0)  iprint = 1
      if (maxiter .eq. 0)  maxiter = 1000
      if (nextiter .eq. 0)  nextiter = 1
      newhess = 1
      done = .false.
      status = '          '
      negtest = .true.
      automode = .false.
      automatic = .false.
      if (mode .eq. 'auto')  automode = .true.
      if (method .eq. 'auto')  automatic = .true.
c
c     set default parameters for the line search
c
      if (cappa .eq. 0.0d0)  cappa = 0.1d0
      if (stpmin .eq. 0.0d0)  stpmin = 1.0d-20
      if (stpmax .eq. 0.0d0)  stpmax = 5.0d0
      if (angmax .eq. 0.0d0)  angmax = 180.0d0
      if (intmax .eq. 0)  intmax = 8
c
c     search each line of the keyword file for options
c
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:7) .eq. 'FCTMIN ') then
            read (record(next:80),*,err=20)  fctmin
         else if (keyword(1:8) .eq. 'MAXITER ') then
            read (record(next:80),*,err=20)  maxiter
         else if (keyword(1:9) .eq. 'NEXTITER ') then
            read (record(next:80),*,err=20)  nextiter
         else if (keyword(1:9) .eq. 'PRINTOUT ') then
            read (record(next:80),*,err=20)  iprint
         else if (keyword(1:9) .eq. 'WRITEOUT ') then
            read (record(next:80),*,err=20)  iwrite
         else if (keyword(1:8) .eq. 'NEWHESS ') then
            read (record(next:80),*,err=20)  newhess
         else if (keyword(1:12) .eq. 'SADDLEPOINT ') then
            negtest = .false.
         else if (keyword(1:6) .eq. 'CAPPA ') then
            read (record(next:80),*,err=20)  cappa
         else if (keyword(1:8) .eq. 'STEPMIN ') then
            read (record(next:80),*,err=20)  stpmin
         else if (keyword(1:8) .eq. 'STEPMAX ') then
            read (record(next:80),*,err=20)  stpmax
         else if (keyword(1:7) .eq. 'ANGMAX ') then
            read (record(next:80),*,err=20)  angmax
         else if (keyword(1:7) .eq. 'INTMAX ') then
            read (record(next:80),*,err=20)  intmax
         end if
   20    continue
      end do
c
c     initialize iteration counter and set its maximum value
c
      iter_tn = nextiter - 1
      maxiter = iter_tn + maxiter
c
c     print header information about the method used
c
      if (iprint .gt. 0) then
         if (mode .eq. 'newton') then
            write (iout,30)
   30       format (/,' Full-Newton Conjugate-Gradient',
     &                ' Optimization :')
         else if (mode .eq. 'tncg') then
            write (iout,40)
   40       format (/,' Truncated-Newton Conjugate-Gradient',
     &                ' Optimization :')
         else if (mode .eq. 'dtncg') then
            write (iout,50)
   50       format (/,' Finite-Difference Truncated-Newton',
     &                ' Conjugate-Gradient Optimization :')
         else if (mode .eq. 'auto') then
            write (iout,60)
   60       format (/,' Variable-Mode Truncated-Newton',
     &                ' Conjugate-Gradient Optimization :')
         end if
         write (iout,70)  mode,method,grdmin
   70    format (/,' Algorithm : ',a6,5x,'Preconditioning : ',a6,5x,
     &             ' RMS Grad : ',d8.2)
         write (iout,80)
   80    format (/,' TN Iter   F Value       G RMS     F Move  ',
     &             '  X Move   CG Iter   Solve   FG Call',/)
      end if
c
c     compute and print initial function and gradient values
c
      iter_cg = 0
      fg_call = 1
      f = fgvalue (x,g)
      f_old = f
      g_norm = 0.0d0
      do i = 1, nvar
         x_old(i) = x(i)
         g_norm = g_norm + g(i)**2
      end do
      g_norm = sqrt(g_norm)
      f_move = 0.5d0 * stpmax * g_norm
      g_rms = g_norm / rms
      if (iprint .gt. 0) then
         if (f.lt.1.0d6 .and. f.gt.-1.0d5 .and. g_rms.lt.1.0d6) then
            write (iout,90)  iter_tn,f,g_rms,fg_call
   90       format (i6,f12.4,f12.4,41x,i7)
         else
            write (iout,100)  iter_tn,f,g_rms,fg_call
  100       format (i6,d12.4,d12.4,41x,i7)
         end if
      end if
c
c     check for termination criteria met by initial point
c
      if (g_rms .le. grdmin) then
         done = .true.
         minimum = f
         if (iprint .gt. 0) then
            write (iout,110)
  110       format (/,' TNCG  --  Normal Termination due to SmallGrad')
         end if
      else if (f .le. fctmin) then
         done = .true.
         minimum = f
         if (iprint .gt. 0) then
            write (iout,120)
  120       format (/,' TNCG  --  Normal Termination due to SmallFct')
         end if
      else if (iter_tn .ge. maxiter) then
         done = .true.
         minimum = f
         if (iprint .gt. 0) then
            write (iout,130)
  130       format (/,' TNCG  --  Incomplete Convergence',
     &                 ' due to IterLimit')
         end if
      end if
c
c     beginning of the truncated Newton cycle;
c     increment the major iteration counter
c
      dowhile (.not. done)
         iter_tn = iter_tn + 1
c
c     if pisystem is present, do the molecular orbital
c     computation, then recompute function and gradient
c
         if (norbit .ne. 0) then
            use_orbit = .false.
            if (iter_tn .ne. nextiter) then
               call piscf
               fg_call = fg_call + 1
               f = fgvalue (x,g)
            end if
         end if
c
c     if using GB/SA solvation, update Born radii occasionally
c
         if (use_gbsa) then
            if (mod(iter_tn,5) .eq. 0) then
               reborn = 1
               call born
            end if
            reborn = 0
         end if
c
c     choose the optimization mode based on the gradient value
c
         if (automode) then
            if (g_rms .ge. 3.0d0) then
               mode = 'tncg'
            else
               mode = 'dtncg'
            end if
         end if
c
c     decide on an optimal preconditioning based on the gradient
c
         if (automatic) then
            if (g_rms .ge. 10.0d0) then
               method = 'diag'
               hesscut = 1.0d0
            else if (nvar .lt. 10) then
               method = 'ssor'
               hesscut = 1.0d0
            else if (g_rms .lt. 1.0d0) then
               method = 'iccg'
               hesscut = 0.001d0 * nvar
               if (hesscut .gt. 0.1d0)  hesscut = 0.1d0
            else
               method = 'iccg'
               hesscut = 0.001d0 * nvar
               if (hesscut .gt. 1.0d0)  hesscut = 1.0d0
            end if
         end if
c
c     compute needed portions of the Hessian matrix
c
         h_mode = 'full'
         if (mod(iter_tn-1,newhess) .ne. 0)  h_mode = 'none'
         if (mode.eq.'dtncg' .and. method.eq.'none')  h_mode = 'none'
         if (mode.eq.'dtncg' .and. method.eq.'diag')  h_mode = 'diag'
         call hmatrix (h_mode,x,h,h_init,h_stop,h_index,h_diag)
c
c     find the next approximate Newton search direction
c
         call solve (mode,method,negtest,nvar,p,x,g,h,
     &               h_init,h_stop,h_index,h_diag,iter_tn,
     &               iter_cg,fg_call,fgvalue,info_solve)
c
c     perform a line search in the chosen direction
c
         info_search = '         '
         call search (nvar,f,g,x,p,f_move,angle,fg_call,
     &                fgvalue,info_search)
c
c     update variables to reflect this iteration
c
         f_move = f_old - f
         f_old = f
         x_move = 0.0d0
         g_norm = 0.0d0
         do i = 1, nvar
            x_move = x_move + (x(i)-x_old(i))**2
            x_old(i) = x(i)
            g_norm = g_norm + g(i)**2
         end do
         x_move = sqrt(x_move)
         x_move = x_move / rms
         if (coordtype .eq. 'internal') then
            x_move = x_move * radian
         end if
         g_norm = sqrt(g_norm)
         g_rms = g_norm / rms
c
c     quit if the maximum number of iterations is exceeded
c
         if (iter_tn .ge. maxiter) then
            done = .true.
            status = 'IterLimit'
         end if
c
c     quit if the function value did not change
c
         if (f_move .eq. 0.0d0) then
            done = .true.
            status = 'NoMotion '
         end if
c
c     quit if either of the normal termination tests are met
c
         if (g_rms .le. grdmin) then
            done = .true.
            status = 'SmallGrad'
         else if (f .le. fctmin) then
            done = .true.
            status = 'SmallFct '
         end if
c
c     set warning if the line search encountered problems
c
         if (info_search .ne. ' Success ') then
            info_solve = info_search
         end if
c
c     print the results for the current iteration
c
         if (iprint .gt. 0) then
            if (done .or. mod(iter_tn,iprint) .eq. 0) then
               if (f.lt.1.0d6 .and. f.gt.-1.0d5 .and.
     &             g_rms.lt.1.0d6 .and. f_move.lt.1.0d5) then
                  write (iout,140)  iter_tn,f,g_rms,f_move,x_move,
     &                              iter_cg,info_solve,fg_call
  140             format (i6,f12.4,f12.4,f11.4,f10.4,i8,3x,a9,i7)
               else
                  write (iout,150)  iter_tn,f,g_rms,f_move,x_move,
     &                              iter_cg,info_solve,fg_call
  150             format (i6,d12.4,d12.4,d11.4,f10.4,i8,3x,a9,i7)
               end if
            end if
         end if
         if (iwrite .gt. 0) then
            if (done .or. mod(iter_tn,iwrite) .eq. 0) then
               call writeout (x,iter_tn)
            end if
         end if
c
c     print the reason for terminating the optimization
c
         if (done) then
            minimum = f
            if (iprint .gt. 0) then
               if (g_rms.le.grdmin .or. f.le.fctmin) then
                  write (iout,160)  status
  160             format (/,' TNCG  --  Normal Termination due to ',a9)
               else
                  write (iout,170)  status
  170             format (/,' TNCG  --  Incomplete Convergence',
     &                       ' due to ',a9)
               end if
            end if
         end if
      end do
      return
      end
