program main

c*********************************************************************72
c
cc MAIN is the main program for ZERO_RC_PRB.
c
c  Discussion:
c
c    ZERO_RC_PRB tests the ZERO_RC library.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    21 January 2013
c
c  Author:
c
c    John Burkardt
c
      implicit none

      call timestamp ( )
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'ZERO_RC_PRB:'
      write ( *, '(a)' ) '  FORTRAN77 version'
      write ( *, '(a)' ) '  Test the ZERO_RC library.'

      call test01 ( )
      call test02 ( )
c
c  Terminate.
c
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'ZERO_RC_PRB:'
      write ( *, '(a)' ) '  Normal end of execution.'
      write ( *, '(a)' ) ' '
      call timestamp ( )

      stop
      end
      subroutine test01 ( )

c*********************************************************************72
c
cc TEST01 tests ROOT_RC.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    21 January 2013
c
c  Author:
c
c    John Burkardt
c
      implicit none

      double precision ferr
      double precision fx
      integer i
      integer it
      integer it_max
      double precision q(9)
      double precision root_rc
      double precision x
      double precision xerr

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST01'
      write ( *, '(a)' ) '  Test ROOT_RC, which searches for an'
      write ( *, '(a)' ) '  approximate solution of F(X) = 0.'
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 
     &  '       X              XERR            FX              FERR'
      write ( *, '(a)' ) ' '
c
c  Initialization.
c
      it = 0
      it_max = 30

      do i = 1, 9
        q(i) = 0.0D+00
      end do

      x = - 2.1D+00
c
c  Each call takes one more step of improvement.
c
10    continue

        fx = cos ( x ) - x

        if ( it .eq. 0 ) then 
          write ( *, '(2x,g14.6,2x,14x,2x,g14.6))' ) x, fx
        else
          write ( *, '(4(2x,g14.6))' ) x, xerr, fx, ferr
        end if

        x = root_rc ( x, fx, ferr, xerr, q )

        if ( ferr .lt. 1.0D-08 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) '  Uncertainty in F(X) less than tolerance'
          go to 20
        end if

        if ( xerr .lt. 1.0D-08 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) '  Width of X interal less than tolerance.'
          go to 20
        end if

        if ( it_max < it ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) '  Too many iterations!'
          go to 20
        end if

        it = it + 1
        
      go to 10

20    continue

      return
      end
      subroutine test02 ( )

c*********************************************************************72
c
cc TEST02 tests ROOTS_RC.
c
c  Licensing:
c
c    This code is distributed under the GNU LGPL license.
c
c  Modified:
c
c    21 January 2013
c
c  Author:
c
c    John Burkardt
c
      implicit none

      integer n
      parameter ( n = 4 )

      double precision ferr
      double precision fx(n)
      integer i
      integer it
      integer it_max
      parameter ( it_max = 30 )
      integer j
      double precision q(2*n+2,n+2)
      double precision x(n)
      double precision xnew(n)

      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TEST02'
      write ( *, '(a)' ) '  Test ROOTS_RC, which seeks a solution of'
      write ( *, '(a)' ) 
     &  '  the N-dimensional nonlinear system F(X) = 0.'
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) '       FERR          X'
      write ( *, '(a)' ) ' '
c
c  Initialization.
c
      do j = 1, n + 2
        do i = 1, 2 * n + 2
          q(i,j) = 0.0D+00
        end do
      end do

      xnew(1) = 1.2D+00
      do i = 2, n
        xnew(i) = 1.0D+00
      end do

      it = 0

10    continue

        do i = 1, n
          x(i) = xnew(i)
        end do

        fx(1) = 1.0D+00 - x(1)
        do i = 2, n
          fx(i) = 10.0D+00 * ( x(i) - x(i-1)**2 )
        end do

        if ( it == 0 ) then
          write ( *, '(2x,14x,5(2x,g14.6))' ) x(1:n)
        else
          write ( *, '(2x,g14.6,5(2x,g14.6))' ) ferr, x(1:n)
        end if

        call roots_rc ( n, x, fx, ferr, xnew, q )

        if ( ferr .lt. 1.0D-07 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) '  Sum of |f(x)| less than tolerance.'
          go to 20
        end if

        if ( it_max .lt. it ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) '  Too many iterations!'
          go to 20
        end if

        it = it + 1

      go to 10

20    continue

      return
      end