!   C05ZAF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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 Functions ..
       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