Program e02cbfe
! E02CBF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: e02cbf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: xmax, xmin, y, ymax, ymin
Integer :: i, ifail, j, k, l, m, m1, m2, &
mfirst, mlast, na, nwork
Logical :: plot
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: a(:), ff(:), work(:), x(:)
! .. Intrinsic Procedures ..
Intrinsic :: min, real
! .. Executable Statements ..
! Skip heading in data file
Read (nin,*)
Read (nin,*) plot
If (.Not. plot) Then
Write (nout,*) 'E02CBF Example Program Results'
End If
Read (nin,*) k, l, m
If (plot) Then
m1 = 1
m2 = m
mlast = m
Else
m1 = (2*m+3)/7
m2 = (6*m+3)/7 + 1
mlast = min(5,m)
End If
na = (k+1)*(l+1)
nwork = k + 1
Allocate (x(mlast),ff(mlast),a(na),work(nwork))
Read (nin,*) a(1:na)
Read (nin,*) ymin, ymax, xmin, xmax
Do j = 1, mlast
x(j) = xmin + (xmax-xmin)*real(j-1,kind=nag_wp)/real(mlast-1,kind= &
nag_wp)
End Do
mfirst = 1
Do i = m1, m2, m1
y = ymin + ((ymax-ymin)*real(i-1,kind=nag_wp))/real(m-1,kind=nag_wp)
ifail = 0
Call e02cbf(mfirst,mlast,k,l,x,xmin,xmax,y,ymin,ymax,ff,a,na,work, &
nwork,ifail)
If (plot) Then
Do j = 1, mlast
Write (nout,99998) y, x(j), ff(j)
End Do
Write (nout,*)
Else
Write (nout,*)
Write (nout,99999) 'Y = ', y
Write (nout,*)
Write (nout,*) ' I X(I) Poly(X(I),Y)'
Do j = 1, mlast
Write (nout,99997) j, x(j), ff(j)
End Do
End If
End Do
99999 Format (1X,A,E13.4)
99998 Format (1X,1P,2E13.4,1P,2E13.4)
99997 Format (1X,I3,1P,2E13.4)
End Program e02cbfe