Program c05rdfe
! C05RDF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: c05rdf, dnrm2, nag_wp, x02ajf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: n = 9, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: factor, fnorm, xtol
Integer :: i, icount, ifail, irevcm, k, mode
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: diag(:), fjac(:,:), fvec(:), qtf(:), &
r(:), rwsav(:), x(:)
Integer, Allocatable :: iwsav(:)
! .. Intrinsic Procedures ..
Intrinsic :: sqrt
! .. Executable Statements ..
Write (nout,*) 'C05RDF Example Program Results'
Allocate (diag(n),fjac(n,n),fvec(n),qtf(n),r(n*(n+ &
1)/2),rwsav(4*n+10),iwsav(17),x(n))
! The following starting values provide a rough solution.
x(1:n) = -1.0E0_nag_wp
xtol = sqrt(x02ajf())
diag(1:n) = 1.0E0_nag_wp
mode = 2
factor = 100.0E0_nag_wp
icount = 0
irevcm = 0
ifail = -1
revcomm: Do
Call c05rdf(irevcm,n,x,fvec,fjac,xtol,mode,diag,factor,r,qtf,iwsav, &
rwsav,ifail)
Select Case (irevcm)
Case (1)
icount = icount + 1
! Insert print statements here to monitor progress if desired.
Cycle revcomm
Case (2)
! Evaluate functions at given point
fvec(1:n) = (3.0E0_nag_wp-2.0E0_nag_wp*x(1:n))*x(1:n) + 1.0E0_nag_wp
fvec(2:n) = fvec(2:n) - x(1:(n-1))
fvec(1:(n-1)) = fvec(1:(n-1)) - 2.0E0_nag_wp*x(2:n)
Cycle revcomm
Case (3)
! Evaluate Jacobian at current point
fjac(1:n,1:n) = 0.0E0_nag_wp
Do k = 1, n
fjac(k,k) = 3.0E0_nag_wp - 4.0E0_nag_wp*x(k)
If (k/=1) Then
fjac(k,k-1) = -1.0E0_nag_wp
End If
If (k/=n) Then
fjac(k,k+1) = -2.0E0_nag_wp
End If
End Do
Cycle revcomm
Case Default
Exit revcomm
End Select
End Do revcomm
If (ifail==0 .Or. ifail==3 .Or. ifail==4 .Or. ifail==5) Then
If (ifail==0) Then
! The NAG name equivalent of dnrm2 is f06ejf
fnorm = dnrm2(n,fvec,1)
Write (nout,*)
Write (nout,99999) 'Final 2-norm of the residuals after', icount, &
' iterations is ', fnorm
Write (nout,*)
Write (nout,*) 'Final approximate solution'
Else
Write (nout,*)
Write (nout,*) 'Approximate solution'
End If
Write (nout,*)
Write (nout,99998)(x(i),i=1,n)
End If
99999 Format (1X,A,I4,A,E12.4)
99998 Format (5X,3F12.4)
End Program c05rdfe