program nitsolma

  use bmproblem, only: pdata_type,iniprob,endprob,evalr
  use iso_c_binding, only: c_ptr,c_loc,c_f_pointer

  implicit none

  ! PARAMETERS
  integer, parameter :: npmax = 150, nmax = ( npmax - 2 ) ** 3, kdmax = 50, &
       lrwork = nmax * ( kdmax + 10 ) + kdmax * ( kdmax + 3 ) 
    
  ! COMMON BLOCKS
  integer :: np
  real(kind=8) :: h,theta,phi(npmax,npmax,npmax),uopt(2:npmax-1,2:npmax-1,2:npmax-1)
  common /bratudata/ phi,uopt,h,theta,np
    
  integer :: iplvl,ipunit
  common /nitprint/ iplvl,ipunit

  real(kind=8) :: choice1_exp,choice2_exp,choice2_coef,eta_cutoff,etamax,thmin,thmax,etafixed
  common /nitparam/ choice1_exp,choice2_exp,choice2_coef,eta_cutoff,etamax,thmin,thmax,etafixed

  ! LOCAL SCALARS
  integer :: allocstat,iterm,n
  real(kind=8) :: finish,ftol,start,stptol
  type(pdata_type), target :: pdata

  ! LOCAL ARRAYS
  integer :: info(6),input(10),ipar(1)
  real(kind=8) :: rpar(1),rwork(lrwork)
  real(kind=8), allocatable :: x(:)

  ! EXTERNAL FUNCTIONS
  integer, external :: ddot,dnrm2

  call iniprob(n,c_loc(pdata))

  allocate(x(n),stat=allocstat)
  if ( allocstat .ne. 0 ) then
     write(*,*) 'Error in allocate.'
     stop
  end if

  x(1:n) = pdata%x0(1:n)
  
  ftol = 1.0d-06 * sqrt( real( n ) )  ! stop when || F(xk) ||_2 / sqrt(n) <= ftol
  stptol = 1.0d-06 ! stopping tolerance on the steplength (value given in the Bratu example)

  input(1:10) =   0 ! set everything to default values
  ! default corresponds to GMRES with finite-difference evaluation of J*v
  ! input(3) =  (default) for GEMRES, 1 for BiCGSTAB, and 2 for TFQMR
  input(1) = 100000 ! maximum number of nonlinear iterations (default 200)
  
  iplvl = 1  ! printout level
  ipunit = 6 ! printout unit
  ! iplvl = 0 => no printout
  !       = 1 => iteration number and F-norm
  !       = 2 => ... + stats, step-norm, lin model norm
  !       = 3 => ... + some Krylov method and backtrack info
  !       = 4 => ... + more Krylov method and backtrack info

  call cpu_time(start)

  call nitsol(n,x,evalrnitsol,evaljnitsol,ftol,stptol,input,info,rwork,rpar,ipar,iterm,ddot,dnrm2)
  
  call cpu_time(finish)

  write(*,*) 'Termination flag iterm       : ',iterm
  write(*,*) 'Final f-norm                 : ',norm2( rwork(1:n) )
  write(*,*) 'No. function evaluations     : ',info(1)
  write(*,*) 'No. J*v evaluations          : ',info(2) 
  write(*,*) 'No. P(inverse)*v evaluations : ',info(3)
  write(*,*) 'No. linear iterations        : ',info(4)
  write(*,*) 'No. nonlinear iterations     : ',info(5)
  write(*,*) 'No. backtracks               : ',info(6)
  
  write(*,*) 'CPU time in seconds = ',finish - start

  open(10,file='tabline.txt')
  write(10,9000) pdata%nprob,n,iterm,norm2(rwork(1:n)),info(1:6),finish-start
  close(10)
    
  deallocate(x,stat=allocstat)
  if ( allocstat .ne. 0 ) then
     write(*,*) 'Error in deallocate.'
     stop
  end if

  call endprob(c_loc(pdata))

  stop

9000 format(1X,I2,1X,I7,1X,I1,1X,1P,D7.1,6(1X,I8),0P,F12.6)

contains
  
  ! ******************************************************************
  ! ******************************************************************

  subroutine evalrnitsol(n,x,r,dpar,ipar,flag)

    implicit none

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

    ! ARRAY ARGUMENTS
    integer, intent(in) :: ipar(*)
    real(kind=8), intent(in) :: dpar(*),x(n)
    real(kind=8), intent(out) :: r(n)

    flag = 0
    
    call evalr(n,x,r,c_loc(pdata))
    
  end subroutine evalrnitsol

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

  subroutine evaljnitsol(n,x,r,ijob,v,z,dpar,ipar,flag)
    
    implicit none

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

    ! ARRAY ARGUMENTS
    integer, intent(in) :: ipar(*)
    real(kind=8), intent(in) :: dpar(*),x(n),r(n),v(n)
    real(kind=8), intent(out) :: z(n)

    flag = 1
    
    write(*,*) 'jac should not be called!'
    
  end subroutine evaljnitsol
  
end program nitsolma
