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
|
subroutine fprpsp(nt,np,co,si,c,f,ncoff)
c given the coefficients of a spherical spline function, subroutine
c fprpsp calculates the coefficients in the standard b-spline re-
c presentation of this bicubic spline.
c ..
c ..scalar arguments
integer nt,np,ncoff
c ..array arguments
real*8 co(np),si(np),c(ncoff),f(ncoff)
c ..local scalars
real*8 cn,c1,c2,c3
integer i,ii,j,k,l,ncof,npp,np4,nt4
c ..
nt4 = nt-4
np4 = np-4
npp = np4-3
ncof = 6+npp*(nt4-4)
c1 = c(1)
cn = c(ncof)
j = ncoff
do 10 i=1,np4
f(i) = c1
f(j) = cn
j = j-1
10 continue
i = np4
j=1
do 70 l=3,nt4
ii = i
if(l.eq.3 .or. l.eq.nt4) go to 30
do 20 k=1,npp
i = i+1
j = j+1
f(i) = c(j)
20 continue
go to 50
30 if(l.eq.nt4) c1 = cn
c2 = c(j+1)
c3 = c(j+2)
j = j+2
do 40 k=1,npp
i = i+1
f(i) = c1+c2*co(k)+c3*si(k)
40 continue
50 do 60 k=1,3
ii = ii+1
i = i+1
f(i) = f(ii)
60 continue
70 continue
do 80 i=1,ncoff
c(i) = f(i)
80 continue
return
end
|
