Polynomial Interpolation with derivatives - fortran

Question

I made a post about this issue a few weeks ago and edited it but I'm not sure if it's still active. So since it is still bothering me I'm making a new one but in a better form, I hope.
For an assignment I am supposed to interpolate function values and derivative values in newton form. I can do it on paper but I'm completely lost when it comes to turning it into a fortran code. I have looked at different source codes but they either opened a file or asked for input, I was given 5 sets of values and have to use those. I was able to write a small program that will do the interpolation without the derivatives. Then I tried to add the derivatives to it.
In the code below "yp" is for the derivatives
program main
implicit none
double precision , allocatable , dimension (:,:) :: nt
double precision , allocatable , dimension (:) :: xnodes, yval, yp
double precision :: x, evalnewton
integer :: i,n,k
n = 7
allocate ( xnodes (0:n), yval (0:n), yp (0:n), nt (0:n, 0:n) )
xnodes = (/ 1.32d0, 2.47d0, 5.81d0, 6.83d0, 7.0d0 /)
yval = (/ 5.63d0, 6.11d0, 8.12d0, 4.33d0, 6.15d0 /)
yp = (/ 1.29d0, 2.21d0, 1.48d0, -3.61d0, 3.11d0 /)
call computent (n, xnodes, yval, yp, nt)
do i = 0,n
x = xnodes(i)
print*, xnodes(i), yval(i), yp(i), evalnewton (n, xnodes, nt, x)
end do
open (unit = 4, file = 'z', status = 'replace')
do i = 0,100
x = dble(i) * 1.0d-1
write (4,*) x, evalnewton (n, xnodes, nt, x)
end do
close (4)
deallocate (xnodes, yval, yp)
stop
end
subroutine computent (n, xnodes, yval, yp, nt)
implicit none
integer :: i, j, n, k, top, bot
double precision :: nt (0:n, 0:n)
double precision xnodes (0:n), yval (0:n), yp(0:n)
double precision :: x, evalnewton
nt = 0.0d0
do i = 0,n
nt (i,0) = yval (i)
end do
do k = 1,n
top = k
bot = 0
do i = k,n
nt (i,k) = (nt (i,k-1) - nt (i-1,k-1))/(xnodes(top) - xnodes(bot))
top = top + 1
bot = bot + 1
end do
print*, 'Column number', k
do j = 0,n
print*, nt (j,k)
end do
end do
return
end
double precision function evalnewton (n, xnodes, nt, x)
implicit none
integer :: i, j, n, k, top, bot
double precision :: nt(0:n, 0:n)
double precision xnodes (0:n), yval(0:n), yp(0:n)
double precision :: x
evalnewton = nt(n,n)
do i = n, 1, -1
evalnewton = evalnewton * (x - xnodes (i-1)) + nt (i-1, i-1)
end do
return
end
To be honest I just added "yp" everywhere, where I had "yval" and hoped for a mystery solver to do its magic. I have not figured out yet what to add so the program will include the derivatives in the calculations. It would be nice if someone could explain me the next steps to take.
EDIT:
I added minor changes to computent which I thought would solve the issue:
do i = 0,n
nt (i*2,0) = yval (i)
nt (i*2+1,0) = yval (i)
end do
do k = 1,n
top = k
bot = 0
do i = k,n
nt (i,k) = (nt (i,k-1) - nt (i-1,k-1))/(xnodes(top) - xnodes(bot))
if (nt(i,k) == 0) then
nt(i,k) = yp(i/2)
end if
top = top + 2
bot = bot + 2
end do
print*, 'Column number', k
do j = 0,n
print*, nt (j,k)
end do
now as first number I get 2.420...e^-322, and that number is messing up the rest of the calculations. Any ideas how to get rid of it?

Answer 1

I'm pretty I figured it out with a small issue. I have it as answer just in case someone else needs it.
program main
implicit none
double precision , allocatable , dimension (:,:) :: yt
double precision , allocatable , dimension (:) :: xnodes, yval, yp, xt
double precision :: x, evalnewton
integer :: i,n,k
n = 9
allocate ( xnodes (0:n), yval (0:n), yp (0:n), yt (0:n, 0:n), xt (0:n) )
xnodes = (/ 1.32d0, 2.47d0, 5.81d0, 6.83d0, 7.0d0 /)
yval = (/ 5.63d0, 6.11d0, 8.12d0, 4.33d0, 6.15d0 /)
yp = (/ 1.29d0, 2.21d0, 1.48d0, -3.61d0, 3.11d0 /)
call computent (n, xnodes, yval, yp, yt, xt)
do i = 0,n
x = xnodes(i)
print*, xnodes(i), yval(i), yp(i), evalnewton (n, xnodes, yt, x)
end do
open (unit = 4, file = 'z', status = 'replace')
do i = 0,100
x = dble(i) * 1.0d-1
write (4,*) x, evalnewton (n, xnodes, yt, x)
end do
close (4)
deallocate (xnodes, yval, yp, yt, xt)
stop
end
subroutine computent (n, xnodes, yval, yp, yt, xt)
implicit none
integer :: i, j, n, k, top, bot
double precision :: yt (0:n, 0:n)
double precision xnodes (0:n), yval (0:n), yp(0:n), xt (0:n)
double precision :: x, evalnewton
xt = 0.0d0
yt = 0.0d0
do i = 0,n
xt(i*2) = xnodes (i)
xt(i*2+1) = xnodes (i)
yt(i*2,0) = yval (i)
yt(i*2+1,0) = yval (i)
end do
do k = 1,n
do i = k,n
yt(i,k) = (yt(i,k-1) - yt(i-1,k-1))/(xt(i) - xt(i-1))
if (xt(i) - xt(i-1) == 0) then
yt(i,k) = yp(i/2)
end if
end do
print*, 'Column number', k
do j = 0,n
print*, yt (j,k)
end do
end do
return
end
double precision function evalnewton (n, xnodes, yt, x)
implicit none
integer :: i, j, n, k, top, bot
double precision :: yt(0:n, 0:n)
double precision xnodes (0:n), yval(0:n), yp(0:n)
double precision :: x
evalnewton = yt(n,n)
do i = n, 1, -1
evalnewton = evalnewton * (x - xnodes (i-1)) + yt (i-1, i-1)
end do
return
end
the small issue is that I get an error message when I run the program and the file is not created
Error Message:
a.out: malloc.c:2372: sysmalloc: Assertion `(old_top == (((mbinptr) (((char *) &((av)->bins[((1) - 1) * 2])) - __builtin_offsetof (struct malloc_chunk, fd)))) && old_size == 0) || ((unsigned long) (old_size) >= (unsigned long)((((__builtin_offsetof (struct malloc_chunk, fd_nextsize))+((2 *(sizeof(size_t))) - 1)) & ~((2 *(sizeof(size_t))) - 1))) && ((old_top)->size & 0x1) && ((unsigned long) old_end & pagemask) == 0)' failed.
Program received signal SIGABRT: Process abort signal.
Backtrace for this error: