V3FIT
gridherm3.f
1  subroutine gridherm3(
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,inf2,inf3,iwarn,ier)
5 c
6 c regrid a hermite function f defined vs. x,y,z as in xpkg, etc.
7 c to a new grid, given by x_newgrid, y_newgrid, z_newgrid
8 c
9 c set warning flag if the range exceeds the range of the
10 c original x/y/zpkg's.
11 c
12 c (xpkg/ypkg/zpkg -- 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 inf2,inf3 ! array dimensions
35  real fspl(0:7,inf2,inf3,nz) ! hermite coefficients of f
36 c
37 c output:
38 c condition codes, =0 for normal exit
39 c
40  integer iwarn ! =1 if new grid points out of range
41  integer ier ! =1 if there is an argument error
42 c
43 c--------------------------------------------
44 c local
45 c
46  real ytmp(nx_new)
47  real 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=z_newgrid(iz)
56  do iy=1,ny_new
57  ytmp=y_newgrid(iy)
58  call vecherm3(ict,nx_new,x_newgrid,ytmp,ztmp,
59  > nx_new,f_new(1,iy,iz),
60  > nx,xpkg,ny,ypkg,nz,zpkg,fspl,inf2,inf3,iwarn,ier)
61  enddo
62  enddo
63 c
64  return
65  end