V3FIT
mkspl2zb.f
1  subroutine mkspl2zb(fun,x,nx,th,nth,fspl,nf2,
2  > ibcxmin,bcxmin,ibcxmax,bcxmax,
3  > wk,inwk,ilinx,ilinth,ier)
4 C
5 C create a bicubic periodic spline with knots at grid points and
6 C function values from the callable function `fun' passed.
7 C
8 C use bpsplinb to setup the spline coefficients
9 C
10 C periodic boundary condition for theta grid;
11 C boundary condition data may be specified at x(1) and x(nx)
12 C ibcxmin=0 ==> "not a knot" boundary condition, cf cubspl.for
13 C ibcxmin=1 ==> match slope, bcxmin(ith) gives df/dx at x(1),th(ith).
14 C ibcxmin=2 ==> match 2nd derivative, given at x(1),th(ith) by bcxmin(ith)
15 C
16 C ibcxmax,bcxmax have analogous interpretation -- at x(nx)
17 C
18  external fun ! passed real function(x,th)
19  real x(nx) ! x coordinate array
20  real th(nth) ! th coordinate array
21 C
22  real fspl(4,nf2,nth) ! function data / spline coeff array
23  real wk(inwk) ! workspace for bpsplinb
24 C
25  integer ibcxmin ! boundary condition indicator
26  real bcxmin(nth) ! boundary condition data
27  integer ibcxmax ! boundary condition indicator
28  real bcxmax(nth) ! boundary condition data
29 C
30  integer ilinx ! output =1 if x(...) evenly spaced
31  integer ilinth ! output =1 if th(...) evenly spaced
32 C
33  integer ier ! completion code from bpspline
34 C
35 C----------------------------
36 C
37  ier=0
38  if(nf2.lt.nx) then
39  write(6,'('.lt.' ?mkspl2pb -- array dim error, nf2nx'')')
40  ier=1
41  endif
42 C
43  do ix=1,nx
44  do ith=1,nth
45  fspl(1,ix,ith)=fun(x(ix),th(ith))
46  enddo
47  enddo
48 C
49  call mkbicubw(x,nx,th,nth,fspl,nf2,
50  > ibcxmin,bcxmin,ibcxmax,bcxmax,
51  > -1,zdummy,-1,zdummy,
52  > wk,inwk,ilinx,ilinth,ier)
53 C
54  return
55  end