add FITPACK Fortran library
start developing of FITPACK C++ bindings mount_server.cpp: fix compilation error with GCC15
This commit is contained in:
44
cxx/fitpack/fpdisc.f
Normal file
44
cxx/fitpack/fpdisc.f
Normal file
@@ -0,0 +1,44 @@
|
||||
recursive subroutine fpdisc(t,n,k2,b,nest)
|
||||
implicit none
|
||||
c subroutine fpdisc calculates the discontinuity jumps of the kth
|
||||
c derivative of the b-splines of degree k at the knots t(k+2)..t(n-k-1)
|
||||
c ..scalar arguments..
|
||||
integer n,k2,nest
|
||||
c ..array arguments..
|
||||
real*8 t(n),b(nest,k2)
|
||||
c ..local scalars..
|
||||
real*8 an,fac,prod
|
||||
integer i,ik,j,jk,k,k1,l,lj,lk,lmk,lp,nk1,nrint
|
||||
c ..local array..
|
||||
real*8 h(12)
|
||||
c ..
|
||||
k1 = k2-1
|
||||
k = k1-1
|
||||
nk1 = n-k1
|
||||
nrint = nk1-k
|
||||
an = nrint
|
||||
fac = an/(t(nk1+1)-t(k1))
|
||||
do 40 l=k2,nk1
|
||||
lmk = l-k1
|
||||
do 10 j=1,k1
|
||||
ik = j+k1
|
||||
lj = l+j
|
||||
lk = lj-k2
|
||||
h(j) = t(l)-t(lk)
|
||||
h(ik) = t(l)-t(lj)
|
||||
10 continue
|
||||
lp = lmk
|
||||
do 30 j=1,k2
|
||||
jk = j
|
||||
prod = h(j)
|
||||
do 20 i=1,k
|
||||
jk = jk+1
|
||||
prod = prod*h(jk)*fac
|
||||
20 continue
|
||||
lk = lp+k1
|
||||
b(lmk,j) = (t(lk)-t(lp))/prod
|
||||
lp = lp+1
|
||||
30 continue
|
||||
40 continue
|
||||
return
|
||||
end
|
||||
Reference in New Issue
Block a user