!   C05ZAF Example Program Text
!   Mark 24 Release. NAG Copyright 2012.

    Module c05zafe_mod

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

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

!       .. Scalar Arguments ..
        Integer, Intent (In)                 :: m, n
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out)     :: fvec(m)
        Real (Kind=nag_wp), Intent (In)      :: x(n)
!       .. 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(m,n,x,fjac,ldfjac)

!       .. Scalar Arguments ..
        Integer, Intent (In)                 :: ldfjac, m, n
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout)   :: fjac(ldfjac,n)
        Real (Kind=nag_wp), Intent (In)      :: x(n)
!       .. 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.0_nag_wp,u*v*denom,u*w*denom/)
        End Do

        Return

      End Subroutine get_fjac
    End Module c05zafe_mod
    Program c05zafe

!     C05ZAF Example Main Program

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

      Allocate (err(m),fjac(ldfjac,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

      Call c05zaf(m,n,x,fvec,fjac,ldfjac,xp,fvecp,mode,err)

      Call get_fvec(m,n,x,fvec)

      Call get_fvec(m,n,xp,fvecp)

      Call get_fjac(m,n,x,fjac,ldfjac)

      mode = 2

      Call c05zaf(m,n,x,fvec,fjac,ldfjac,xp,fvecp,mode,err)

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

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

        Do i = 1, m

          If (err(i)<=0.5E0_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 c05zafe
