V3FIT
r8mkspl2z.f
1  subroutine r8mkspl2z(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 !============
10 ! idecl: explicitize implicit INTEGER declarations:
11  IMPLICIT NONE
12  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
13  INTEGER nth,nf2,inwk,nx,ix,ith
14 !============
15 ! idecl: explicitize implicit REAL declarations:
16  real*8 fun,zdummy
17 !============
18  external fun ! passed real function(x,th)
19  real*8 x(nx) ! x coordinate array
20  real*8 th(nth) ! th coordinate array
21 C
22 C output:
23 C
24  real*8 fspl(4,nf2,nth) ! function data / spline coeff array
25  real*8 wk(inwk) ! workspace -- at least 5*max(nx,nth)
26 C
27  integer ilinx ! output =1 if x(1...nx) evenly spaced
28  integer ilinth ! output =1 if th(1..nth) evenly spaced
29 C
30  integer ier ! completion code from bpspline 0=OK
31 C
32 C----------------------------
33 C
34  ier=0
35  if(nf2.lt.nx) then
36  write(6,'('.lt.' ?mkspl2p -- array dim error, nf2nx'')')
37  ier=1
38  endif
39 C
40  do ix=1,nx
41  do ith=1,nth
42  fspl(1,ix,ith)=fun(x(ix),th(ith))
43  enddo
44  enddo
45 C
46  call r8mkbicubw(x,nx,th,nth,fspl,nf2,
47  > 0,zdummy,0,zdummy,-1,zdummy,-1,zdummy,
48  > wk,inwk,ilinx,ilinth,ier)
49 C
50  return
51  end