Program c05rd_t1w_fe
!     C05RD_T1W_F Example Main Program

!     Mark 30.3 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use iso_c_binding, Only: c_ptr
      Use nagad_library, Only: c05rd_t1w_f, nagad_t1w_w_rtype, x10aa_t1w_f,    &
                               x10ab_t1w_f, Assignment (=), Operator (-),      &
                               Operator (+), Operator (*)
      Use nag_library, Only: nag_wp, x02ajf, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: mode = 2, n = 7, nout = 6
!     .. Local Scalars ..
      Type (c_ptr)                     :: ad_handle
      Type (nagad_t1w_w_rtype)         :: factor, xtol
      Integer                          :: i, ifail, irevcm, j
!     .. Local Arrays ..
      Type (nagad_t1w_w_rtype), Allocatable :: diag(:), fjac(:,:), fvec(:),    &
                                          qtf(:), r(:), rwsav(:), x(:)
      Type (nagad_t1w_w_rtype)         :: ruser(5)
      Real (Kind=nag_wp), Allocatable  :: dr(:,:)
      Integer, Allocatable             :: iwsav(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: sqrt
!     .. Executable Statements ..

      Write (nout,*) 'C05RD_T1W_F Example Program Results'

      Allocate (diag(n),fjac(n,n),fvec(n),qtf(n),r(n*(n+                       &
        1)/2),x(n),rwsav(4*n+10),iwsav(17),dr(n,5))

!     Create AD configuration data object
      ifail = 0
      Call x10aa_t1w_f(ad_handle,ifail)

      ruser(1) = -1.0_nag_wp
      ruser(2) = 3.0_nag_wp
      ruser(3) = -2.0_nag_wp
      ruser(4) = -2.0_nag_wp
      ruser(5) = -1.0_nag_wp

      xtol = sqrt(x02ajf())
      factor = 100._nag_wp

      Do i = 1, 5

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

        diag(1:n) = 1.0_nag_wp

        ruser(i)%tangent = 0.5_nag_wp

        irevcm = 0

revcomm: Do

          ifail = 0
          Call c05rd_t1w_f(ad_handle,irevcm,n,x,fvec,fjac,xtol,mode,diag,      &
            factor,r,qtf,iwsav,rwsav,ifail)

          Select Case (irevcm)
          Case (1)
!           Monitoring exit.
            Cycle revcomm
          Case (2)
            fvec(:) = (ruser(2)+ruser(3)*x)*x - ruser(5)
            fvec(2:n) = fvec(2:n) + ruser(1)*x(1:n-1)
            fvec(1:n-1) = fvec(1:n-1) + ruser(4)*x(2:n)
          Case (3)
            fjac(1:n,1:n) = 0.0_nag_wp
            fjac(1,1) = ruser(2) + 2.0_nag_wp*ruser(3)*x(1)
            fjac(1,2) = ruser(4)
            Do j = 2, n - 1
              fjac(j,j-1) = ruser(1)
              fjac(j,j) = ruser(2) + 2.0_nag_wp*ruser(3)*x(j)
              fjac(j,j+1) = ruser(4)
            End Do
            fjac(n,n-1) = ruser(1)
            fjac(n,n) = ruser(2) + 2.0_nag_wp*ruser(3)*x(n)
          Case Default
            Exit revcomm
          End Select

        End Do revcomm

        dr(:,i) = 2._nag_wp*x%tangent

        ruser(i)%tangent = 0._nag_wp
      End Do

      Write (nout,*) 'Final approximate solution'
      Write (nout,99999)(x(i)%value,i=1,n)
99999 Format (1X,3F12.4)


      Write (nout,*)
      Write (nout,*) ' Derivatives calculated: First order tangents'
      Write (nout,*) ' Computational mode    : algorithmic'
      Write (nout,*)
      Write (nout,*) ' Derivatives are of solution w.r.t function params'
      Write (nout,*)

      Call x04caf('General',' ',n,5,dr,n,'       dx/druser',ifail)

!     Remove computational data object
      Call x10ab_t1w_f(ad_handle,ifail)

    End Program c05rd_t1w_fe