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 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
|
subroutine bispev(tx,nx,ty,ny,c,kx,ky,x,mx,y,my,z,wrk,lwrk,
* iwrk,kwrk,ier)
c subroutine bispev evaluates on a grid (x(i),y(j)),i=1,...,mx; j=1,...
c ,my a bivariate spline s(x,y) of degrees kx and ky, given in the
c b-spline representation.
c
c calling sequence:
c call bispev(tx,nx,ty,ny,c,kx,ky,x,mx,y,my,z,wrk,lwrk,
c * iwrk,kwrk,ier)
c
c input parameters:
c tx : real array, length nx, which contains the position of the
c knots in the x-direction.
c nx : integer, giving the total number of knots in the x-direction
c ty : real array, length ny, which contains the position of the
c knots in the y-direction.
c ny : integer, giving the total number of knots in the y-direction
c c : real array, length (nx-kx-1)*(ny-ky-1), which contains the
c b-spline coefficients.
c kx,ky : integer values, giving the degrees of the spline.
c x : real array of dimension (mx).
c before entry x(i) must be set to the x co-ordinate of the
c i-th grid point along the x-axis.
c tx(kx+1)<=x(i-1)<=x(i)<=tx(nx-kx), i=2,...,mx.
c mx : on entry mx must specify the number of grid points along
c the x-axis. mx >=1.
c y : real array of dimension (my).
c before entry y(j) must be set to the y co-ordinate of the
c j-th grid point along the y-axis.
c ty(ky+1)<=y(j-1)<=y(j)<=ty(ny-ky), j=2,...,my.
c my : on entry my must specify the number of grid points along
c the y-axis. my >=1.
c wrk : real array of dimension lwrk. used as workspace.
c lwrk : integer, specifying the dimension of wrk.
c lwrk >= mx*(kx+1)+my*(ky+1)
c iwrk : integer array of dimension kwrk. used as workspace.
c kwrk : integer, specifying the dimension of iwrk. kwrk >= mx+my.
c
c output parameters:
c z : real array of dimension (mx*my).
c on succesful exit z(my*(i-1)+j) contains the value of s(x,y)
c at the point (x(i),y(j)),i=1,...,mx;j=1,...,my.
c ier : integer error flag
c ier=0 : normal return
c ier=10: invalid input data (see restrictions)
c
c restrictions:
c mx >=1, my >=1, lwrk>=mx*(kx+1)+my*(ky+1), kwrk>=mx+my
c tx(kx+1) <= x(i-1) <= x(i) <= tx(nx-kx), i=2,...,mx
c ty(ky+1) <= y(j-1) <= y(j) <= ty(ny-ky), j=2,...,my
c
c other subroutines required:
c fpbisp,fpbspl
c
c references :
c de boor c : on calculating with b-splines, j. approximation theory
c 6 (1972) 50-62.
c cox m.g. : the numerical evaluation of b-splines, j. inst. maths
c applics 10 (1972) 134-149.
c dierckx p. : curve and surface fitting with splines, monographs on
c numerical analysis, oxford university press, 1993.
c
c author :
c p.dierckx
c dept. computer science, k.u.leuven
c celestijnenlaan 200a, b-3001 heverlee, belgium.
c e-mail : Paul.Dierckx@cs.kuleuven.ac.be
c
c latest update : march 1987
c
c ..scalar arguments..
integer nx,ny,kx,ky,mx,my,lwrk,kwrk,ier
c ..array arguments..
integer iwrk(kwrk)
real*8 tx(nx),ty(ny),c((nx-kx-1)*(ny-ky-1)),x(mx),y(my),z(mx*my),
* wrk(lwrk)
c ..local scalars..
integer i,iw,lwest
c ..
c before starting computations a data check is made. if the input data
c are invalid control is immediately repassed to the calling program.
ier = 10
lwest = (kx+1)*mx+(ky+1)*my
if(lwrk.lt.lwest) go to 100
if(kwrk.lt.(mx+my)) go to 100
if (mx.lt.1) go to 100
if (mx.eq.1) go to 30
go to 10
10 do 20 i=2,mx
if(x(i).lt.x(i-1)) go to 100
20 continue
30 if (my.lt.1) go to 100
if (my.eq.1) go to 60
go to 40
40 do 50 i=2,my
if(y(i).lt.y(i-1)) go to 100
50 continue
60 ier = 0
iw = mx*(kx+1)+1
call fpbisp(tx,nx,ty,ny,c,kx,ky,x,mx,y,my,z,wrk(1),wrk(iw),
* iwrk(1),iwrk(mx+1))
100 return
end
|