!   E04FFF Example Program Text

!   Mark 30.3 Release. nAG Copyright 2024.

    Module e04fffe_mod

!     Problem data derived type to be passed to objfun through cpuser

!     .. Use Statements ..
      Use iso_c_binding, Only: c_f_pointer, c_ptr
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: objfun
!     .. Derived Type Definitions ..
      Type, Public                     :: pdata
        Integer                        :: ny, nz
        Real (Kind=nag_wp), Allocatable :: y(:), z(:)
      End Type pdata

    Contains

      Subroutine objfun(nvar,x,nres,rx,inform,iuser,ruser,cpuser)

!       Bounded Kowalik and Osborne function

!       .. Scalar Arguments ..
        Type (c_ptr), Intent (In)      :: cpuser
        Integer, Intent (Inout)        :: inform
        Integer, Intent (In)           :: nres, nvar
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
        Real (Kind=nag_wp), Intent (Out) :: rx(nres)
        Real (Kind=nag_wp), Intent (In) :: x(nvar)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Local Scalars ..
        Type (pdata), Pointer          :: pd
        Real (Kind=nag_wp)             :: r1, r2
        Integer                        :: i
!       .. Executable Statements ..

!       Interrupt solver if the dimensions are incorrect
        If (nres/=11 .Or. nvar/=4) Then
          inform = -1
          Go To 100
        End If

!       extract the problem data structure from the C pointer
        Call c_f_pointer(cpuser,pd)
        If (pd%ny/=nres .Or. pd%nz/=nres) Then
          inform = -1
          Go To 100
        End If

        Do i = 1, nres
          r1 = pd%y(i)*(pd%y(i)+x(2))
          r2 = pd%y(i)*(pd%y(i)+x(3)) + x(4)
          rx(i) = pd%z(i) - x(1)*r1/r2
        End Do

100     Continue
        Return

      End Subroutine objfun
    End Module e04fffe_mod


    Program e04fffe

!     .. Use Statements ..
      Use e04fffe_mod, Only: objfun, pdata
      Use iso_c_binding, Only: c_loc, c_ptr
      Use nag_library, Only: e04fff, e04ffu, 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)                     :: cpuser, handle
      Type (pdata), Target             :: pd
      Integer                          :: ifail, isparse, nnzrd, nres, nvar
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: lx(:), rx(:), ux(:), x(:)
      Real (Kind=nag_wp)               :: rinfo(100), ruser(1), stats(100)
      Integer                          :: icolrd(1), irowrd(1), iuser(1)
!     .. Executable Statements ..

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

!     fill the problem data structure
      pd%ny = 11
      pd%nz = 11
      Allocate (pd%y(pd%ny),pd%z(pd%nz))

      pd%y(1:11) = (/4.0E0_nag_wp,2.0E0_nag_wp,1.0E0_nag_wp,5.0E-1_nag_wp,     &
        2.5E-1_nag_wp,1.67E-1_nag_wp,1.25E-1_nag_wp,1.0E-1_nag_wp,             &
        8.33E-2_nag_wp,7.14E-2_nag_wp,6.25E-2_nag_wp/)
      pd%z(1:11) = (/1.957E-1_nag_wp,1.947E-1_nag_wp,1.735E-1_nag_wp,          &
        1.6E-1_nag_wp,8.44E-2_nag_wp,6.27E-2_nag_wp,4.56E-2_nag_wp,            &
        3.42E-2_nag_wp,3.23E-2_nag_wp,2.35E-2_nag_wp,2.46E-2_nag_wp/)

      nvar = 4
      nres = 11

!     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)
      Call e04zmf(handle,'DFO version = latest',ifail)

!     Define starting point
      Allocate (x(nvar),rx(nres))
      x(1:4) = (/0.25_nag_wp,0.39_nag_wp,0.415_nag_wp,0.39_nag_wp/)

!     Define bounds for the second and the fourth variable
      Allocate (lx(nvar),ux(nvar))
      lx(1:4) = (/-infbnd,0.2_nag_wp,-infbnd,0.3_nag_wp/)
      ux = infbnd
      ux(2) = 1.0_nag_wp
      Call e04rhf(handle,nvar,lx,ux,ifail)

!     Call the solver
      ifail = -1
      cpuser = c_loc(pd)
      Call e04fff(handle,objfun,e04ffu,nvar,x,nres,rx,rinfo,stats,iuser,ruser, &
        cpuser,ifail)

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

    End Program e04fffe