! *****************************************************************
! *****************************************************************

program bmbunchma

  implicit none

  ! LOCAL SCALARS
  integer :: allocstatus,fcnt,hnnz,inform,iter,local_hnnz,m,maxfcnt,maxit,n,status
  real(kind=8) :: eps,f,finish,ftarget,gnorm,start

  ! LOCAL ARRAYS
  character(len=10) :: pname
  character(len=10), allocatable :: xnames(:)
  integer, allocatable :: hcol(:),hrow(:)
  real(kind=8), allocatable :: g(:),l(:),u(:),x(:)

  open(10,file='OUTSDIF.d',form='formatted',status='old')

  rewind 10

  call cutest_udimen(status,10,n)
  if ( status .ne. 0 ) then
     write(*,*) 'cutest_udimen: status not equal to zero. status = ',status
     stop
  end if

  allocate(g(n),x(n),l(n),u(n),xnames(n),stat=allocstatus )
  if ( allocstatus .ne. 0 ) then
     write(*,*) 'Error in allocate!'
     stop
  end if

  call cutest_usetup(status,10,6,4,n,x,l,u)
  if ( status .ne. 0 ) then
     write(*,*) 'cutest_usetup: status not equal to zero. status = ',status
     stop
  end if

  call cutest_unames(status,n,pname,xnames)

  call cutest_udimsh(status,hnnz)
  if ( status .ne. 0 ) then
     write(*,*) 'cutest_udimsh: status not equal to zero. status = ',status
     stop
  end if

  allocate(hrow(hnnz),hcol(hnnz),stat=allocstatus )
  if ( allocstatus .ne. 0 ) then
     write(*,*) 'Error in allocate!'
     stop
  end if

  call cutest_ushp(status,n,local_hnnz,hnnz,hrow,hcol)

  if ( local_hnnz .ne. hnnz ) then
     write(*,*) 'cutest_udimsh return hnnzmax = ',hnnz
     write(*,*) 'cutest_ushp return hnnz = ',local_hnnz
     stop
  end if
  
  close(10)

  write(*,*) 
  write(*,*) 
  write(*,*) '=========================================='
  write(*,*) '=========================================='
  write(*,*) 'Problem name: ',pname
  write(*,*) 'Number of variables n = ',n
  write(*,*) '=========================================='
  write(*,*) '=========================================='
  write(*,*) 
  write(*,*) 
  
  eps = 1.0d-08
  ftarget = - 1.0d+10
  maxit = 50000
  maxfcnt = 10 * maxit
  
  if ( pname .eq. 'ARGLINC' ) then
     m = 1000
     ftarget = real( ( m ** 2 + 3 * m - 6 ), kind=8 ) / ( 2 * ( 2 * m - 3 ) )
     ftarget = ftarget + 1.0d-15 * abs( ftarget )
     write(*,*) 'Valor de ftarget = ',ftarget
  end if

  open(10,file='bmbunch-cutest-ran-out-of-time.txt')
  close(10)

  call cpu_time(start)
  call CRNewton(n,x,f,g,gnorm,eps,ftarget,maxit,maxfcnt,hnnz,hrow,hcol,iter,fcnt,inform)
  call cpu_time(finish)
        
  open(10,file='bmbunch-cutest-ran-out-of-time.txt')
  close(10,status='delete')

  open(10,file='bmbunch-cutest-table.txt',access='append')
  write(10,100) pname,n,f,gnorm,iter,fcnt,finish-start,inform
  close(10)
        
  write(*,*) 'problem                                = ',pname
  write(*,*) 'Inform                                 = ',inform
  write(*,*) 'Final objective functional value       = ',f
  write(*,*) 'Final sup-norm of the gradient         = ',gnorm
  write(*,*) 'Total number of iterations             = ',iter
  write(*,*) 'total number of functional evaluations = ',fcnt
  write(*,*) 'Elapsed CPU time in seconds            = ',finish-start
  
  deallocate(g,x,l,u,xnames,hrow,hcol,stat=allocstatus )
  if ( allocstatus .ne. 0 ) then
     write(*,*) 'Error in deallocate!'
     stop
  end if

  stop

100 format(A10,1X,I10,3X,1PD17.10,1X,1PD7.1,I6,1X,I6,1X,0P,F8.2,1X,I3)

end program bmbunchma

! *****************************************************************
! *****************************************************************

subroutine evalf(n,x,f,flag)

  implicit none

  ! SCALAR ARGUMENTS
  integer, intent(in) :: n
  integer, intent(out) :: flag
  real(kind=8), intent(out) :: f

  ! ARRAY ARGUMENTS
  real(kind=8), intent(in) :: x(n)

  ! SCALAR PARAMETERS
  real( kind=8), parameter :: lrgstreal = huge( 1.0d0 )

  ! LOCAL SCALARS
  integer :: status

  flag = 0

  call cutest_ufn(status,n,x,f)
  if ( status .ne. 0 ) flag = - 1

  ! This is true if f is NaN
  if ( .not. ( f .eq. f ) ) then
     flag = - 1
  end if
  
  ! This is true if f is a +/- Infty
  if ( .not. abs( f ) .le. lrgstreal ) then
     flag = 1
     return
  end if

end subroutine evalf

! *****************************************************************
! *****************************************************************

subroutine evalg(n,x,g,flag)

  implicit none

  ! SCALAR ARGUMENTS
  integer, intent(in) :: n
  integer, intent(out) :: flag

  ! ARRAY ARGUMENTS
  real(kind=8), intent(in) :: x(n)
  real(kind=8), intent(out) :: g(n)

  ! SCALAR PARAMETERS
  real( kind=8), parameter :: lrgstreal = huge( 1.0d0 )

  ! LOCAL SCALARS
  integer :: status

  flag = 0

  call cutest_ugr(status,n,x,g)
  if ( status .ne. 0 ) flag = - 1

  ! This is true if there is a NaN
  if ( .not. all( g(1:n) .eq. g(1:n) ) ) then
     flag = - 1
  end if
  
  ! This is true if there is a +/- Infty
  if ( .not. all( abs( g(1:n) ) .le. lrgstreal ) ) then
     flag = 1
     return
  end if
  
end subroutine evalg

! *****************************************************************
! *****************************************************************

subroutine evalh(n,x,hnnz,hrow,hcol,hval,flag)

  implicit none

  ! SCALAR ARGUMENTS
  integer, intent(in) :: hnnz,n
  integer, intent(out) :: flag

  ! ARRAY ARGUMENTS
  real(kind=8), intent(in) :: x(n)
  integer, intent(in) :: hcol(hnnz),hrow(hnnz)
  real(kind=8), intent(out) :: hval(hnnz)

  ! SCALAR PARAMETERS
  real( kind=8), parameter :: lrgstreal = huge( 1.0d0 )

  ! LOCAL SCALARS
  integer :: local_hnnz,status

  ! LOCAL ARRAYS
  integer :: local_hcol(hnnz),local_hrow(hnnz)

  flag = 0

  ! Upper triangle
  call cutest_ush(status,n,x,local_hnnz,hnnz,hval,local_hrow,local_hcol)
  if ( status .ne. 0 ) then
     flag = - 1
     return
  end if

  if ( local_hnnz .ne. hnnz ) then
     flag = - 1
     return
  end if

  if ( any( local_hrow(1:hnnz) .ne. hrow(1:hnnz) ) .or. &
       any( local_hcol(1:hnnz) .ne. hcol(1:hnnz) ) ) then
     flag = - 1
     return
  end if
  
  ! This is true if there is a NaN
  if ( .not. all( hval(1:hnnz) .eq. hval(1:hnnz) ) ) then
     flag = - 1
  end if

  ! This is true if there is a +/- Infty
  if ( .not. all( abs( hval(1:hnnz) ) .le. lrgstreal ) ) then
     flag = 1
     return
  end if
  
end subroutine evalh