V3FIT
mkspl2z.f
1  subroutine mkspl2z(fun,x,nx,th,nth,fspl,nf2,wk,inwk,
2  > ilinx,ilinth,ier)
3 C
4 C create a bicubic periodic spline with knots at grid points and
5 C function values from the callable function `fun' passed.
6 C
7 C use bpspline to setup the spline coefficients
8 C
9  external fun ! passed real function(x,th)
10  real x(nx) ! x coordinate array
11  real th(nth) ! th coordinate array
12 C
13 C output:
14 C
15  real fspl(4,nf2,nth) ! function data / spline coeff array
16  real wk(inwk) ! workspace -- at least 5*max(nx,nth)
17 C
18  integer ilinx ! output =1 if x(1...nx) evenly spaced
19  integer ilinth ! output =1 if th(1..nth) evenly spaced
20 C
21  integer ier ! completion code from bpspline 0=OK
22 C
23 C----------------------------
24 C
25  ier=0
26  if(nf2.lt.nx) then
27  write(6,'('.lt.' ?mkspl2p -- array dim error, nf2nx'')')
28  ier=1
29  endif
30 C
31  do ix=1,nx
32  do ith=1,nth
33  fspl(1,ix,ith)=fun(x(ix),th(ith))
34  enddo
35  enddo
36 C
37  call mkbicubw(x,nx,th,nth,fspl,nf2,
38  > 0,zdummy,0,zdummy,-1,zdummy,-1,zdummy,
39  > wk,inwk,ilinx,ilinth,ier)
40 C
41  return
42  end