1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
subroutine fpinst(iopt,t,n,c,k,x,l,tt,nn,cc,nest)
c given the b-spline representation (knots t(j),j=1,2,...,n, b-spline
c coefficients c(j),j=1,2,...,n-k-1) of a spline of degree k, fpinst
c calculates the b-spline representation (knots tt(j),j=1,2,...,nn,
c b-spline coefficients cc(j),j=1,2,...,nn-k-1) of the same spline if
c an additional knot is inserted at the point x situated in the inter-
c val t(l)<=x<t(l+1). iopt denotes whether (iopt.ne.0) or not (iopt=0)
c the given spline is periodic. in case of a periodic spline at least
c one of the following conditions must be fulfilled: l>2*k or l<n-2*k.
c
c ..scalar arguments..
integer k,n,l,nn,iopt,nest
real*8 x
c ..array arguments..
real*8 t(nest),c(nest),tt(nest),cc(nest)
c ..local scalars..
real*8 fac,per,one
integer i,i1,j,k1,m,mk,nk,nk1,nl,ll
c ..
one = 0.1e+01
k1 = k+1
nk1 = n-k1
c the new knots
ll = l+1
i = n
do 10 j=ll,n
tt(i+1) = t(i)
i = i-1
10 continue
tt(ll) = x
do 20 j=1,l
tt(j) = t(j)
20 continue
c the new b-spline coefficients
i = nk1
do 30 j=l,nk1
cc(i+1) = c(i)
i = i-1
30 continue
i = l
do 40 j=1,k
m = i+k1
fac = (x-tt(i))/(tt(m)-tt(i))
i1 = i-1
cc(i) = fac*c(i)+(one-fac)*c(i1)
i = i1
40 continue
do 50 j=1,i
cc(j) = c(j)
50 continue
nn = n+1
if(iopt.eq.0) return
c incorporate the boundary conditions for a periodic spline.
nk = nn-k
nl = nk-k1
per = tt(nk)-tt(k1)
i = k1
j = nk
if(ll.le.nl) go to 70
do 60 m=1,k
mk = m+nl
cc(m) = cc(mk)
i = i-1
j = j-1
tt(i) = tt(j)-per
60 continue
return
70 if(ll.gt.(k1+k)) return
do 80 m=1,k
mk = m+nl
cc(mk) = cc(m)
i = i+1
j = j+1
tt(j) = tt(i)+per
80 continue
return
end
|
