FIXME : Add documentation
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real, | intent(in) | :: | t | |||
integer, | intent(in) | :: | n | |||
real, | intent(in), | dimension(n) | :: | x | ||
real, | intent(in), | dimension(n) | :: | y | ||
real, | intent(in), | dimension(n) | :: | yp | ||
real, | intent(in) | :: | sigma |
real function fitp_curv2 (t,n,x,y,yp,sigma)
implicit none
integer, intent(in) :: n
real, dimension(n), intent(in) :: x, y, yp
real, intent(in) :: t, sigma
!
! coded by alan kaylor cline
! from fitpack -- january 26, 1987
! a curve and surface fitting package
! a product of pleasant valley software
! 8603 altus cove, austin, texas 78759, usa
!
! this function interpolates a curve at a given point
! using a spline under tension. the subroutine curv1 should
! be called earlier to determine certain necessary
! parameters.
!
! on input--
!
! t contains a real value to be mapped onto the interpo-
! lating curve.
!
! n contains the number of points which were specified to
! determine the curve.
!
! x and y are arrays containing the abscissae and
! ordinates, respectively, of the specified points.
!
! yp is an array of second derivative values of the curve
! at the nodes.
!
! and
!
! sigma contains the tension factor (its sign is ignored).
!
! the parameters n, x, y, yp, and sigma should be input
! unaltered from the output of curv1.
!
! on output--
!
! curv2 contains the interpolated value.
!
! none of the input parameters are altered.
!
! this function references package modules intrvl and
! snhcsh.
!
!-----------------------------------------------------------
integer :: i, im1
real :: ss, sigdel, s1, s2, sum, sigmap
real :: del1, del2, dels
!
! determine interval
!
im1 = fitp_intrvl(t,x,n)
i = im1+1
!
! denormalize tension factor
!
sigmap = abs(sigma) * (n - 1) / (x(n) - x(1))
!
! set up and perform interpolation
!
del1 = t-x(im1)
del2 = x(i)-t
dels = x(i)-x(im1)
sum = (y(i)*del1+y(im1)*del2)/dels
if (is_zero(sigmap)) then
fitp_curv2 = sum-del1*del2*(yp(i)*(del1+dels)+yp(im1)*(del2+dels))/(6.*dels)
else
sigdel = sigmap*dels
ss = sinhm_fun(sigdel)
s1 = sinhm_fun(sigmap * del1)
s2 = sinhm_fun(sigmap * del2)
fitp_curv2 = sum+(yp(i)*del1*(s1-ss)+yp(im1)*del2*(s2-ss))/(sigdel*sigmap*(1.+ss))
end if
end function fitp_curv2