Program e01bafe
! E01BAF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: e01baf, e02bbf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: m = 7, nout = 6
Integer, Parameter :: lck = m + 4
Integer, Parameter :: lwrk = 6*m + 16
Real (Kind=nag_wp), Parameter :: x(m) = (/0.0E0_nag_wp,0.2E0_nag_wp, &
0.4E0_nag_wp,0.6E0_nag_wp, &
0.75E0_nag_wp,0.9E0_nag_wp, &
1.0E0_nag_wp/)
! .. Local Scalars ..
Real (Kind=nag_wp) :: fit, xarg
Integer :: ifail, j, r
! .. Local Arrays ..
Real (Kind=nag_wp) :: c(lck), lamda(lck), wrk(lwrk), y(m)
! .. Intrinsic Procedures ..
Intrinsic :: exp
! .. Executable Statements ..
Write (nout,*) 'E01BAF Example Program Results'
y(1:m) = exp(x(1:m))
ifail = 0
Call e01baf(m,x,y,lamda,c,lck,wrk,lwrk,ifail)
Write (nout,*)
Write (nout,*) ' J Knot LAMDA(J+2) B-spline coeff C(J)'
Write (nout,*)
j = 1
Write (nout,99998) j, c(1)
Do j = 2, m - 1
Write (nout,99999) j, lamda(j+2), c(j)
End Do
Write (nout,99998) m, c(m)
Write (nout,*)
Write (nout,*) &
' R Abscissa Ordinate Spline'
Write (nout,*)
Do r = 1, m
ifail = 0
Call e02bbf(m+4,lamda,c,x(r),fit,ifail)
Write (nout,99999) r, x(r), y(r), fit
If (r<m) Then
xarg = 0.5E0_nag_wp*(x(r)+x(r+1))
ifail = 0
Call e02bbf(m+4,lamda,c,xarg,fit,ifail)
Write (nout,99997) xarg, fit
End If
End Do
99999 Format (1X,I4,F15.4,2F20.4)
99998 Format (1X,I4,F35.4)
99997 Format (1X,F19.4,F40.4)
End Program e01bafe