FIXME : Add documentation
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real, | intent(in) | :: | t | |||
integer, | intent(in) | :: | n | |||
real, | intent(in), | dimension(:) | :: | x | ||
real, | intent(in), | dimension(:) | :: | y | ||
real, | intent(in) | :: | p | |||
real, | intent(in), | dimension(:) | :: | yp | ||
real, | intent(in) | :: | sigma |
real function fitp_curvpd (t,n,x,y,p,yp,sigma)
real, intent(in) :: t, p, sigma
integer, intent(in) :: n
real, dimension(:), intent(in) :: x, y, yp
!
! 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 is the derivative of curvp2
! interpolates a curve at a given point using
! a periodic spline under tension. the subroutine curvp1
! 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.
!
! p contains the period.
!
! 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, p, yp, and sigma should be input
! unaltered from the output of curvp1.
!
! on output--
!
! curvpd contains the interpolated derivative
!
! none of the input parameters are altered.
!
! this function references package modules intrvp and
! snhcsh.
!
!-----------------------------------------------------------
integer :: i, im1
real :: ss, sigdel, sum, c2, c1
real :: tp, sigmap, dels, del2, del1
!
! determine interval
!
tp = fitp_periodic_wrap_value(t, x(1), p)
im1 = fitp_intrvp (tp, x, n)
i = im1+1
!
! denormalize tension factor
!
sigmap = abs(sigma) * n / p
!
! set up and perform interpolation
!
del1 = tp-x(im1)
if (im1 .eq. n) then
i = 1
del2 = x(1)+p-tp
dels = p-(x(n)-x(1))
else
del2 = x(i)-tp
dels = x(i)-x(im1)
end if
! Here on identical to fitp_curvd
sum = (y(i)-y(im1))/dels
if (is_zero(sigmap)) then
fitp_curvpd = sum+(yp(i)*(2.*del1*del1-del2*(del1+dels))- &
yp(im1)*(2.*del2*del2-del1*(del2+dels))) &
/(6.*dels)
else
sigdel = sigmap*dels
ss = sinhm_fun(sigdel)
c1 = coshm_fun(sigmap * del1)
c2 = coshm_fun(sigmap * del2)
fitp_curvpd = sum+(yp(i)*(c1-ss)-yp(im1)*(c2-ss))/(sigdel*sigmap*(1.+ss))
end if
end function fitp_curvpd