V3FIT
tcspgrid.f
1  subroutine tcspgrid(
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,fspl,inf4,inf5,iwarn,ier)
5 c
6 c regrid a spline function f defined vs. x,y,z as in xpkg,ypkg,zpkg
7 c to a new grid, given by x_newgrid, y_newgrid, z_newgrid
8 c
9 c set warning flag if the range of x_newgrid or y_newgrid or z_newgrid
10 c exceeds the range of the original xpkg or ypkg or zpkg.
11 c
12 c (xpkg,ypkg,zpkg arrays -- axis data, see genxpkg subroutine)
13 c
14 c input:
15 c
16  real x_newgrid(nx_new) ! new x grid
17  real y_newgrid(ny_new) ! new y grid
18  real z_newgrid(nz_new) ! new z grid
19 c
20 c output:
21 c
22  integer if1,if2 ! 1st dimensions of f_new
23  real f_new(if1,if2,nz_new) ! f evaluated on this grid
24 c
25 c input:
26 c
27  integer nx ! size of old grid
28  real xpkg(nx,4) ! old grid "package"
29  integer ny ! size of old grid
30  real ypkg(ny,4) ! old grid "package"
31  integer nz ! size of old grid
32  real zpkg(nz,4) ! old grid "package"
33 c
34  integer inf4 ! array dimension
35  integer inf5 ! array dimension
36  real fspl(4,4,4,inf4,inf5,nz) ! spline coefficients of f
37 c
38 c output:
39 c condition codes, =0 for normal exit
40 c
41  integer iwarn ! =1 if new grid points out of range
42  integer ier ! =1 if there is an argument error
43 c
44 c--------------------------------------------
45 c local
46 c
47  real ytmp(nx_new),ztmp(nx_new)
48  integer ict(10)
49 c
50  data ict/1,0,0,0,0,0,0,0,0,0/
51 c
52 c--------------------------------------------
53 c
54  do iz=1,nz_new
55  ztmp=y_newgrid(iz)
56  do iy=1,ny_new
57  ytmp=y_newgrid(iy)
58  call tcspvec(ict,nx_new,x_newgrid,ytmp,ztmp,
59  > nx_new,f_new(1,iy,iz),
60  > nx,xpkg,ny,ypkg,nz,zpkg,fspl,inf4,inf5,iwarn,ier)
61  enddo
62  enddo
63 c
64  return
65  end