!   C05ZDF Example Program Text
!   Mark 30.3 Release. nAG Copyright 2024.

    Module c05zdfe_mod

!     C05ZDF Example Program Module:
!            Parameters and User-defined Routines

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: get_fjac, get_fvec
!     .. Parameters ..
      Integer, Parameter, Public       :: m = 15, n = 3, nout = 6
    Contains
      Subroutine get_fvec(x,fvec)

!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: fvec(:)
        Real (Kind=nag_wp), Intent (In) :: x(:)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: u, v, w
        Integer                        :: i
!       .. Local Arrays ..
        Real (Kind=nag_wp), Allocatable :: y(:)
!       .. Intrinsic Procedures ..
        Intrinsic                      :: min, real
!       .. Executable Statements ..
        Allocate (y(m))

        y(1:m) = real((/14,18,22,25,29,32,35,39,47,58,73,96,134,210,439/),     &
          kind=nag_wp)
        y(1:m) = y(1:m)*0.01_nag_wp

        Do i = 1, m
          u = real(i,kind=nag_wp)
          v = real(m+1-i,kind=nag_wp)
          w = min(u,v)
          fvec(i) = y(i) - (x(1)+u/(v*x(2)+w*x(3)))
        End Do

        Return
      End Subroutine get_fvec
      Subroutine get_fjac(x,fjac)

!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout) :: fjac(:,:)
        Real (Kind=nag_wp), Intent (In) :: x(:)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: denom, u, v, w
        Integer                        :: i
!       .. Intrinsic Procedures ..
        Intrinsic                      :: min, real
!       .. Executable Statements ..
        Do i = 1, m
          u = real(i,kind=nag_wp)
          v = real(m+1-i,kind=nag_wp)
          w = min(u,v)
          denom = (v*x(2)+w*x(3))**(-2)
          fjac(i,1:n) = (/-1.0E0_nag_wp,u*v*denom,u*w*denom/)
        End Do

        Return
      End Subroutine get_fjac
    End Module c05zdfe_mod
    Program c05zdfe

!     C05ZDF Example Main Program

!     .. Use Statements ..
      Use c05zdfe_mod, Only: get_fjac, get_fvec, m, n, nout
      Use nag_library, Only: c05zdf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Integer                          :: i, ifail, mode
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: err(:), fjac(:,:), fvec(:),          &
                                          fvecp(:), x(:), xp(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: any
!     .. Executable Statements ..
      Write (nout,*) 'C05ZDF Example Program Results'

      Allocate (err(m),fjac(m,n),fvec(m),fvecp(m),x(n),xp(n))

!     Point at which to check gradients:

      x(1:n) = (/0.92_nag_wp,0.13_nag_wp,0.54_nag_wp/)

      mode = 1

      ifail = 0
      Call c05zdf(mode,m,n,x,fvec,fjac,xp,fvecp,err,ifail)

      Call get_fvec(x,fvec)

      Call get_fvec(xp,fvecp)

      Call get_fjac(x,fjac)

      mode = 2

      ifail = 0
      Call c05zdf(mode,m,n,x,fvec,fjac,xp,fvecp,err,ifail)

      Write (nout,*)
      Write (nout,99999) 'At point ', (x(i),i=1,n), ','

      If (any(err(1:m)<=0.5_nag_wp)) Then

        Do i = 1, m

          If (err(i)<=0.5_nag_wp) Then
            Write (nout,99998) 'suspicious gradient number ', i,               &
              ' with error measure ', err(i)
          End If

        End Do

      Else
        Write (nout,99997) 'gradients appear correct'
      End If

99999 Format (1X,A,3F12.4,A)
99998 Format (1X,A,I5,A,F12.4)
99997 Format (1X,A)
    End Program c05zdfe