V3FIT
mkspl2p.f
1  subroutine mkspl2p(fun,x,nx,th,nth,fspl,nf3,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,4,nf3,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(nf3.lt.nx) then
27  write(6,'('.lt.' ?mkspl2p -- array dim error, nf3nx'')')
28  ier=1
29  endif
30  if(inwk.lt.5*max(nx,nth)) then
31  write(6,'('' ?mkspl2p -- array dim error, inwk too small'')')
32  ier=2
33  endif
34 C
35  do ix=1,nx
36  do ith=1,nth
37  fspl(1,1,ix,ith)=fun(x(ix),th(ith))
38  enddo
39  enddo
40 C
41  call bpspline(x,nx,th,nth,fspl,nf3,wk,inwk,ilinx,ilinth,ier)
42 C
43  return
44  end