V3FIT
r8mkspl2zb.f
1  subroutine r8mkspl2zb(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 !============
19 ! idecl: explicitize implicit INTEGER declarations:
20  IMPLICIT NONE
21  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
22  INTEGER nth,nf2,inwk,nx,ix,ith
23 !============
24 ! idecl: explicitize implicit REAL declarations:
25  real*8 fun,zdummy
26 !============
27  external fun ! passed real function(x,th)
28  REAL*8 x(nx) ! x coordinate array
29  real*8 th(nth) ! th coordinate array
30 C
31  real*8 fspl(4,nf2,nth) ! function data / spline coeff array
32  real*8 wk(inwk) ! workspace for bpsplinb
33 C
34  integer ibcxmin ! boundary condition indicator
35  REAL*8 bcxmin(nth) ! boundary condition data
36  integer ibcxmax ! boundary condition indicator
37  real*8 bcxmax(nth) ! boundary condition data
38 C
39  integer ilinx ! output =1 if x(...) evenly spaced
40  integer ilinth ! output =1 if th(...) evenly spaced
41 C
42  integer ier ! completion code from bpspline
43 C
44 C----------------------------
45 C
46  ier=0
47  if(nf2.lt.nx) then
48  write(6,'('.lt.' ?mkspl2pb -- array dim error, nf2nx'')')
49  ier=1
50  endif
51 C
52  do ix=1,nx
53  do ith=1,nth
54  fspl(1,ix,ith)=fun(x(ix),th(ith))
55  enddo
56  enddo
57 C
58  call r8mkbicubw(x,nx,th,nth,fspl,nf2,
59  > ibcxmin,bcxmin,ibcxmax,bcxmax,
60  > -1,zdummy,-1,zdummy,
61  > wk,inwk,ilinx,ilinth,ier)
62 C
63  return
64  end