program main

c*********************************************************************72
c
cc cg_plus_test() tests cg_plus().
c
c  Licensing:
c
c    This software is freely available for educational or commercial 
c    use, but we expect that all publications describing work using 
c    this software quote at least one of the references given below.
c
c  Author:
c
c    G. Liu, J. Nocedal, R. Waltz
c
c  Reference:
c
c    J C Gilbert, J Nocedal,
c    Global Convergence Properties of Conjugate Gradient Methods, 
c    SIAM Journal on Optimization, Volume 2, pages 21-42, 1992.
c

c
c Change the maximum size of the problem dimension here
c
      parameter        (ndim=10000)
      double precision x(ndim),g(ndim),d(ndim),gold(ndim),w(ndim)
      double precision f,eps,tlev
      double precision time1,time2,tottime
      logical          finish
      integer          iprint(2),iflag,icall,n,method,mp,lp,i
      integer          iter,nfun

      common /cgdd/    mp,lp
      common /runinf/  iter,nfun

      data one/1.0D+0/

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'cg_plus_test()'
      write ( *, '(a)' ) '  Fortran77 tewst'
      write ( *, '(a)' ) '  Test cg_plus().'

      FINISH= .FALSE.
c
c Read problem input information
c
      n =         2
      method =   3 
      irest =     1   
      iprint(1) = 1 
      iprint(2) = 0  
c
c Check for correct dimension value n
c
      if (n .lt. 0) then
         iflag = -3
         write(*,850)
         go to 50
      end if

      if (n .gt. ndim) then
         iflag = -3
         write(*,860)
         go to 50
      end if
c
c Get the initial vector x
c
      do i=1,n
        x(i) = -2.0D+00
      end do
c
c Print parameters
c
      if (iprint(1) .ge. 0) then
         write (*,820)
         write (*,840) n, method, irest
      end if

        ICALL=0
c
c This is the convergence constant 
c
        EPS= 1.0D-5

c IFLAG=0 indicates an initial entry to program

        IFLAG=0
c
c Begin counting CPU time. 
c (Note: This function may not work on all operating systems.)
c
        call timer(time1)

  20    CONTINUE
c
c Calculate the function and gradient values here
c
c Rosenbrock test function
      call fcn(n,x,f,g)

 30   CONTINUE
c
c Call the main optimization code
c
        CALL CGFAM(N,X,F,G,D,GOLD,IPRINT,EPS,W,
     *            IFLAG,IREST,METHOD,FINISH )
c
c       IFLAG=
c              0 : successful termination
c              1 : return to evaluate F and G
c              2 : return with a new iterate, try termination test
c             -i : error
c
      IF(IFLAG.LE.0.OR.ICALL.GT.10000) GO TO 50
        IF(IFLAG.EQ.1) THEN
         ICALL=ICALL + 1         
         GO TO 20
        ENDIF      
        IF(IFLAG.EQ.2) THEN
c
c Termination Test.  The user may replace it by some other test. However, 
c the parameter 'FINISH' must be set to 'TRUE' when the test is satisfied.
c
         TLEV= EPS*(ONE + DABS(F))
         I=0
  40     I=I+1
         IF(I.GT.N) THEN
              FINISH = .TRUE.
            GO TO 30
         ENDIF
         IF(DABS(G(I)).GT.TLEV) THEN
            GO TO 30
         ELSE
            GO TO 40
         ENDIF

        ENDIF

  50  continue
c
c End CPU counting
c
        call timer(time2)
c
c Calculate the elapsed time
c
        tottime = time2-time1
c
c Code has terminated; print final results
c
      if (iprint(1).ge.0.and.iflag.ge.0) then
         write (*,890) f
         write (*,900) tottime
      end if

      write ( *, '(a)' ) ''
      write ( *, '(a)' ) 'cg_plus_test()'
      write ( *, '(a)' ) '  Normal end of execution.'
      stop
c
c Formatting
c
 820  format (//, ' Conjugate Gradient Minimization Routine', /)
 840  format (/, ' n      =', i6, /,
     *             ' method   =', i6,/,
     *             ' irest    =', i6,/)
 850  format (/,'  Error: negative N value'/)
 860  format (/,'  Error: N too large, increase parameter ndim'/)
 890  format (/,' f(x*) =', 1pd16.8)
 900  format (' It took ',1pd12.6,' CPU seconds'/)

      end
      subroutine fcn( n, x, f, g )

c*********************************************************************72
c
cc FCN evaluates the function.
c
      integer n
      double precision x(n), f, g(n)

c Rosenbrock 
      f = 100.*((x(2) - x(1)**2)**2) + (1. - x(1))**2
      g(1) = 200*(x(2) - x(1)**2)*(-2*x(1)) - 2*(1 - x(1))
      g(2) = 200*(x(2) - x(1)**2)

      return
      end