Program e01cffe
! E01CFF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: e01cef, e01cff, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: lam
Integer :: i, ifail, m, n
Logical :: negfor, yfor
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: comm(:), forval(:), intval(:), x(:), &
xi(:), y(:)
! .. Intrinsic Procedures ..
Intrinsic :: real
! .. Executable Statements ..
Write (nout,*) 'E01CFF Example Program Results'
! Skip heading in data file
Read (nin,*)
! Input the number of nodes.
Read (nin,*) n, m
Allocate (x(n),y(n),comm(4*n+10),xi(m),intval(m),forval(m))
! Input whether negative forward differences are allowed, and whether
! supplied values are forward differences
Read (nin,*) negfor, yfor
! Read amelioration parameter value
Read (nin,*) lam
! Read in data points x and y.
Read (nin,*)(x(i),y(i),i=1,n)
! Interpolation setup
ifail = 0
Call e01cef(n,lam,negfor,yfor,x,y,comm,ifail)
forval = 0.0_nag_wp
intval = 0.0_nag_wp
! Interpolate at values in range [0:x(n)+0.2] in steps of 0.1
Write (nout,99999) 'i', 'x', 'Rate', 'Forward'
Do i = 1, m
xi(i) = real(i,kind=nag_wp)*0.1_nag_wp - 0.1_nag_wp
End Do
ifail = 0
Call e01cff(m,xi,intval,forval,comm,ifail)
Do i = 1, m
Write (nout,99998) i, xi(i), intval(i), forval(i)
End Do
Deallocate (x,y,comm,xi,intval,forval)
99999 Format (T1,A,T6,A,T13,A,T20,A)
99998 Format (I3.3,F7.2,F7.3,F7.3)
End Program e01cffe