!   E04KFF Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

!   NLP example: Nonlinear objective + box constraints

    Module e04kffe_mod

!     .. Use Statements ..
      Use, Intrinsic                   :: iso_c_binding, Only: c_ptr
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: objfun, objgrd

    Contains

      Subroutine objfun(nvar,x,fx,inform,iuser,ruser,cpuser)

!       .. Implicit None Statement ..
        Implicit None
!       .. Scalar Arguments ..
        Type (c_ptr), Intent (In)      :: cpuser
        Real (Kind=nag_wp), Intent (Out) :: fx
        Integer, Intent (Inout)        :: inform
        Integer, Intent (In)           :: nvar
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(nvar)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Executable Statements ..

!       Rosenbrock function
        fx = (1.0_nag_wp-x(1))**2 + 100.0_nag_wp*(x(2)-x(1)**2)**2

        Return

      End Subroutine objfun

      Subroutine objgrd(nvar,x,nnzfd,fdx,inform,iuser,ruser,cpuser)

!       .. Implicit None Statement ..
        Implicit None
!       .. Scalar Arguments ..
        Type (c_ptr), Intent (In)      :: cpuser
        Integer, Intent (Inout)        :: inform
        Integer, Intent (In)           :: nnzfd, nvar
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout) :: fdx(nvar), ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(nvar)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Executable Statements ..

        fdx(1) = 2.0_nag_wp*x(1) - 400.0_nag_wp*x(1)*(x(2)-x(1)**2) -          &
          2.0_nag_wp
        fdx(2) = 200.0_nag_wp*(x(2)-x(1)**2)

        Return

      End Subroutine objgrd

    End Module e04kffe_mod

    Program e04kffe

!     .. Use Statements ..
      Use e04kffe_mod, Only: objfun, objgrd
      Use, Intrinsic                   :: iso_c_binding, Only: c_null_ptr,     &
                                          c_ptr
      Use nag_library, Only: e04kff, e04kfu, e04raf, e04rgf, e04rhf, e04rxf,   &
                             e04rzf, e04zmf, nag_wp, x04acf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nmonit = 9, nout = 6, nvar = 2
!     .. Local Scalars ..
      Type (c_ptr)                     :: cpuser, handle
      Integer                          :: ifail, j, nu
      Character (40)                   :: opt
!     .. Local Arrays ..
      Real (Kind=nag_wp)               :: blx(nvar), bux(nvar), rinfo(100),    &
                                          ruser(1), stats(100), u(2*nvar),     &
                                          x(nvar)
      Integer                          :: iidx(nvar), iuser(1)
!     .. Executable Statements ..

      cpuser = c_null_ptr
      nu = 2*nvar

      Write (nout,Fmt=99999) 'E04KFF Example Program Results'

!     Define filename for monitoring output
      ifail = 0
      Call x04acf(nmonit,'e04kffe.mon',1,ifail)

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

!     Define initial guess point
      x(1:nvar) = (/-1.5_nag_wp,1.9_nag_wp/)

!     Define Simple box bounds on X
      blx(1:nvar) = (/-1.0_nag_wp,-2.0_nag_wp/)
      bux(1:nvar) = (/0.8_nag_wp,2.0_nag_wp/)
      ifail = 0
      Call e04rhf(handle,nvar,blx,bux,ifail)

!     Add nonlinear objective information
      iidx(1:nvar) = (/(j,j=1,nvar)/)
      ifail = 0
      Call e04rgf(handle,nvar,iidx,ifail)

!     Add options
      ifail = 0
      Call e04zmf(handle,'FOAS Print Frequency = 5',ifail)

      ifail = 0
      Call e04zmf(handle,'Print Solution = yes',ifail)

      ifail = 0
      Call e04zmf(handle,'Print Level = 1',ifail)

      ifail = 0
      Write (opt,Fmt=99998) 'Monitoring File', nmonit
      Call e04zmf(handle,opt,ifail)

      ifail = 0
      Call e04zmf(handle,'Monitoring Level = 3',ifail)

!     Solve the problem
      ifail = -1
      Call e04kff(handle,objfun,objgrd,e04kfu,nvar,x,rinfo,stats,iuser,ruser,  &
        cpuser,ifail)

!     Print objective value at solution
      If (ifail==0 .Or. ifail==50) Then
        Write (nout,Fmt=99997) rinfo(1)
!       Retrieve Lagrange multipliers (FDX)
        Call e04rxf(handle,'U',1,nu,u,ifail)
        If (ifail==0) Then
          Write (nout,Fmt=99996) u(1) - u(2), u(3) - u(4)
          Write (nout,Fmt=99995) u(1), u(3)
          Write (nout,Fmt=99994) u(2), u(4)
        End If
      End If

      Write (nout,Fmt=99999) ''

!     Clean up
      ifail = 0
      Call e04rzf(handle,ifail)

99999 Format (A30)
99998 Format (A24,'=',I15)
99997 Format (2/,1X,'Solution found:',/,2X,                                    &
        'Objective function value at solution:',1X,Es9.1e2)
99996 Format (2X,'Gradient at solution:',16X,2(1X,Es9.1e2),/)
99995 Format (2X,'Estimated Lagrange multipliers: blx',2X,2(1X,Es9.1e2))
99994 Format (2X,'Estimated Lagrange multipliers: bux',2X,2(1X,Es9.1e2))

    End Program e04kffe