V3FIT
mkspl2pb.f
1  subroutine mkspl2pb(fun,x,nx,th,nth,fspl,nf3,
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,4,nf3,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(nf3.lt.nx) then
39  write(6,'('.lt.' ?mkspl2pb -- array dim error, nf3nx'')')
40  ier=1
41  endif
42  if(inwk.lt.5*max(nx,nth)) then
43  write(6,'('' ?mkspl2pb -- array dim error, inwk too small'')')
44  ier=2
45  endif
46 C
47  do ix=1,nx
48  do ith=1,nth
49  fspl(1,1,ix,ith)=fun(x(ix),th(ith))
50  enddo
51  enddo
52 C
53  call bpsplinb(x,nx,th,nth,fspl,nx,ibcxmin,bcxmin,ibcxmax,bcxmax,
54  > wk,inwk,ilinx,ilinth,ier)
55 C
56  return
57  end
Generated on Thu Mar 5 2020 15:49:24 for V3FIT by   doxygen 1.8.17