V3FIT
r8gridintrp3d.f
1  subroutine r8gridintrp3d(
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 !============
19 ! idecl: explicitize implicit INTEGER declarations:
20  IMPLICIT NONE
21  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
22  INTEGER ny_new,nz_new,nx_new,iz,iy
23 !============
24  REAL*8 x_newgrid(nx_new) ! new x grid
25  real*8 y_newgrid(ny_new) ! new y grid
26  real*8 z_newgrid(nz_new) ! new z grid
27 c
28 c output:
29 c
30  integer if1,if2 ! 1st dimensions of f_new
31  real*8 f_new(if1,if2,nz_new) ! f evaluated on this grid
32 c
33 c input:
34 c
35  integer nx ! size of old grid
36  real*8 xpkg(nx,4) ! old grid "package"
37  integer ny ! size of old grid
38  REAL*8 ypkg(ny,4) ! old grid "package"
39  integer nz ! size of old grid
40  real*8 zpkg(nz,4) ! old grid "package"
41 c
42  integer :: jspline(3) ! interpolation type, by dimension
43  ! -1: zonal step fcn; 0: pclin; 1: Hermite; 2: Spline
44 
45  integer :: icoeff ! coefficients per data point
46  integer :: ixdim,iydim,izdim ! fspl dimensions
47  ! ixdim=nx unless zonal step fcn interpolation in x is used
48  ! similar comment applies to iydim,izdim
49 
50  real*8 fspl(icoeff,ixdim,iydim,izdim) ! spline coefficients of f
51 c
52 c output:
53 c condition codes, =0 for normal exit
54 c
55  integer iwarn ! =1 if new grid points out of range
56  integer ier ! =1 if there is an argument error
57 c
58 c--------------------------------------------
59 c local
60 c
61  real*8 ytmp(nx_new)
62  real*8 ztmp(nx_new)
63  integer ict(10)
64 c
65  data ict/1,0,0,0,0,0,0,0,0,0/
66 c
67 c--------------------------------------------
68 c
69  do iz=1,nz_new
70  ztmp=z_newgrid(iz)
71  do iy=1,ny_new
72  ytmp=y_newgrid(iy)
73  call r8vecintrp3d(ict,nx_new,x_newgrid,ytmp,ztmp,
74  > nx_new,f_new(1,iy,iz),
75  > nx,xpkg,ny,ypkg,nz,zpkg,
76  > jspline,fspl,icoeff,ixdim,iydim,izdim,
77  > iwarn,ier)
78  enddo
79  enddo
80 c
81  return
82  end