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

    Module c05qsfe_mod

!     C05QSF 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                           :: fcn
!     .. Parameters ..
      Integer, Parameter, Public       :: n = 9, nout = 6
    Contains
      Subroutine fcn(n,lindf,indf,x,fvec,iuser,ruser,iflag)

!       .. Parameters ..
        Real (Kind=nag_wp), Parameter  :: one = 1.0E0_nag_wp
        Real (Kind=nag_wp), Parameter  :: three = 3.0E0_nag_wp
        Real (Kind=nag_wp), Parameter  :: two = 2.0E0_nag_wp
        Real (Kind=nag_wp), Parameter  :: alpha = (one/two)**7
!       .. Scalar Arguments ..
        Integer, Intent (Inout)        :: iflag
        Integer, Intent (In)           :: lindf, n
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: fvec(n)
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
        Real (Kind=nag_wp), Intent (In) :: x(n)
        Integer, Intent (In)           :: indf(lindf)
        Integer, Intent (Inout)        :: iuser(*)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: theta
        Integer                        :: i, ind
!       .. Intrinsic Procedures ..
        Intrinsic                      :: real
!       .. Executable Statements ..
        iflag = 0
        theta = real(iuser(1),kind=nag_wp)*alpha
        Do ind = 1, lindf
          i = indf(ind)
          fvec(i) = (three-(two+theta)*x(i))*x(i) + one
          If (i>1) Then
            fvec(i) = fvec(i) - x(i-1)
          End If
          If (i<n) Then
            fvec(i) = fvec(i) - two*x(i+1)
          End If
        End Do
        Return

      End Subroutine fcn
    End Module c05qsfe_mod
    Program c05qsfe

!     .. Use Statements ..
      Use c05qsfe_mod, Only: fcn, n, nout
      Use nag_library, Only: c05qsf, dnrm2, nag_wp, x02ajf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: fnorm, xtol
      Integer                          :: i, ifail, j, licomm, lrcomm
      Logical                          :: init
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: fvec(:), rcomm(:), x(:)
      Real (Kind=nag_wp)               :: ruser(1)
      Integer, Allocatable             :: icomm(:)
      Integer                          :: iuser(1)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: sqrt
!     .. Executable Statements ..
      Write (nout,*) 'C05QSF Example Program Results'

      xtol = sqrt(x02ajf())
      lrcomm = 12 + 3*n
      licomm = 8*n + 19 + 3*n

      Allocate (fvec(n),x(n),rcomm(lrcomm),icomm(licomm))

!     The following starting values provide a rough solution.
      x(1:n) = -1.0E0_nag_wp

      Do i = 0, 1
        ifail = -1

!       Perturb the system?
        iuser(1) = i

        init = (i==0)
        Call c05qsf(fcn,n,x,fvec,xtol,init,rcomm,lrcomm,icomm,licomm,iuser,    &
          ruser,ifail)

        Select Case (ifail)
        Case (0)
!         The NAG name equivalent of dnrm2 is f06ejf
          fnorm = dnrm2(n,fvec,1)
          Write (nout,*)
          Write (nout,99999) 'Final 2-norm of the residuals =', fnorm
          Write (nout,*)
          Write (nout,*) 'Final approximate solution'
          Write (nout,*)
          Write (nout,99998)(x(j),j=1,n)
        Case (2:4)
          Write (nout,*)
          Write (nout,*) 'Approximate solution'
          Write (nout,*)
          Write (nout,99998)(x(j),j=1,n)
        End Select
      End Do

99999 Format (1X,A,E12.4)
99998 Format (1X,3F12.4)
    End Program c05qsfe