!   E04FGF Example Program Text

    Program e04fgfe

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use iso_c_binding, Only: c_ptr
      Use nag_library, Only: e04fgf, e04raf, e04rhf, e04rmf, e04rzf, e04zmf,   &
                             nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: infbnd = 1.0E20_nag_wp
      Integer, Parameter               :: nout = 6
!     .. Local Scalars ..
      Type (c_ptr)                     :: handle
      Integer                          :: i, ifail, irevcm, isparse, maxeval,  &
                                          neval, nnzrd, nres, nvar
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: lx(:), rx(:,:), ux(:), x(:,:)
      Real (Kind=nag_wp)               :: rinfo(100), stats(100)
      Integer                          :: icolrd(1), irowrd(1)
!     .. Executable Statements ..

      Write (nout,*) 'E04FGF Example Program Results'
      Write (nout,*)
      Flush (nout)

      nvar = 2
      nres = 2
      maxeval = 2

!     Initialize handle
      ifail = 0
      Call e04raf(handle,nvar,ifail)

!     Define residuals structure, isparse=0 means the residual structure is
!     dense => irowrd and icolrd are not accessed
      isparse = 0
      nnzrd = 1
      Call e04rmf(handle,nres,isparse,nnzrd,irowrd,icolrd,ifail)

!     Set options
!     relax the main convergence criteria a bit
      Call e04zmf(handle,'DFO Trust Region Tolerance = 5.0e-6',ifail)
!     Print the solution
      Call e04zmf(handle,'Print Solution = YES',ifail)

!     Define starting point
      Allocate (x(nvar,maxeval),rx(nres,maxeval))
      x(1:2,1) = (/-1.2_nag_wp,1.0_nag_wp/)

!     Define bounds for the variables
      Allocate (lx(nvar),ux(nvar))
      lx(1:2) = (/-1.5_nag_wp,-2.0_nag_wp/)
      ux(1:2) = (/2.0_nag_wp,infbnd/)
      Call e04rhf(handle,nvar,lx,ux,ifail)

!     Call the solver in the reverse communication loop
      irevcm = 1
      Do While (irevcm/=0)
        ifail = -1
        Call e04fgf(handle,irevcm,neval,maxeval,nvar,x,nres,rx,rinfo,stats,    &
          ifail)
        If (irevcm==1) Then
          Do i = 1, neval
!           Compute the rosenbrock objective function on the required points
            rx(1,i) = 1.0_nag_wp - x(1,i)
            rx(2,i) = 10.0_nag_wp*(x(2,i)-x(1,i)**2)
          End Do
        End If
      End Do

!     Free the handle memory
      ifail = 0
      Call e04rzf(handle,ifail)

    End Program e04fgfe