V3FIT
gridintrp3d.f
1  subroutine gridintrp3d(
2  > x_newgrid,nx_new,y_newgrid,ny_new,z_newgrid,nz_new,
3  > f_new,if1,if2,
4  > nx,xpkg,ny,ypkg,nz,zpkg,
5  > jspline,fspl,icoeff,ixdim,iydim,izdim,
6  > iwarn,ier)
7 c
8 c regrid a spline function f defined vs. x,y,z as in xpkg, etc.
9 c to a new grid, given by x_newgrid, y_newgrid, z_newgrid
10 c
11 c set warning flag if the range exceeds the range of the
12 c original x/y/zpkg's.
13 c
14 c (xpkg/ypkg/zpkg -- axis data, see genxpkg subroutine)
15 c
16 c input:
17 c
18  real x_newgrid(nx_new) ! new x grid
19  real y_newgrid(ny_new) ! new y grid
20  real z_newgrid(nz_new) ! new z grid
21 c
22 c output:
23 c
24  integer if1,if2 ! 1st dimensions of f_new
25  real f_new(if1,if2,nz_new) ! f evaluated on this grid
26 c
27 c input:
28 c
29  integer nx ! size of old grid
30  real xpkg(nx,4) ! old grid "package"
31  integer ny ! size of old grid
32  real ypkg(ny,4) ! old grid "package"
33  integer nz ! size of old grid
34  real zpkg(nz,4) ! old grid "package"
35 c
36  integer :: jspline(3) ! interpolation type, by dimension
37  ! -1: zonal step fcn; 0: pclin; 1: Hermite; 2: Spline
38 
39  integer :: icoeff ! coefficients per data point
40  integer :: ixdim,iydim,izdim ! fspl dimensions
41  ! ixdim=nx unless zonal step fcn interpolation in x is used
42  ! similar comment applies to iydim,izdim
43 
44  real fspl(icoeff,ixdim,iydim,izdim) ! spline coefficients of f
45 c
46 c output:
47 c condition codes, =0 for normal exit
48 c
49  integer iwarn ! =1 if new grid points out of range
50  integer ier ! =1 if there is an argument error
51 c
52 c--------------------------------------------
53 c local
54 c
55  real ytmp(nx_new)
56  real ztmp(nx_new)
57  integer ict(10)
58 c
59  data ict/1,0,0,0,0,0,0,0,0,0/
60 c
61 c--------------------------------------------
62 c
63  do iz=1,nz_new
64  ztmp=z_newgrid(iz)
65  do iy=1,ny_new
66  ytmp=y_newgrid(iy)
67  call vecintrp3d(ict,nx_new,x_newgrid,ytmp,ztmp,
68  > nx_new,f_new(1,iy,iz),
69  > nx,xpkg,ny,ypkg,nz,zpkg,
70  > jspline,fspl,icoeff,ixdim,iydim,izdim,
71  > iwarn,ier)
72  enddo
73  enddo
74 c
75  return
76  end