V3FIT
r8gridintrp2d.f
1  subroutine r8gridintrp2d(
2  > x_newgrid,nx_new,y_newgrid,ny_new,f_new,if1,
3  > nx,xpkg,ny,ypkg,jspline,fspl,icoeff,ixdim,iydim,iwarn,ier)
4 c
5 c regrid a spline function f defined vs. x,y as in xpkg,ypkg
6 c to a new grid, given by x_newgrid, y_newgrid
7 c
8 c set warning flag if the range x_newgrid, y_newgrid
9 c exceeds the range of the original xpkg,ypkg.
10 c
11 c (xpkg,ypkg -- axis data, see genxpkg subroutine)
12 c
13 c input:
14 c
15 !============
16 ! idecl: explicitize implicit INTEGER declarations:
17  IMPLICIT NONE
18  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
19  INTEGER ny_new,nx_new,iy
20 !============
21  real*8 x_newgrid(nx_new) ! new x grid
22  real*8 y_newgrid(ny_new) ! new y grid
23 c
24 c output:
25 c
26  integer if1 ! 1st dimension of f_new
27  REAL*8 f_new(if1,ny_new) ! f evaluated on this grid
28 c
29 c input:
30 c
31  integer nx ! size of old grid
32  REAL*8 xpkg(nx,4) ! old grid "package"
33  integer ny ! size of old grid
34  real*8 ypkg(ny,4) ! old grid "package"
35 c
36  integer jspline(2) ! interpolation type by dimension
37  integer :: icoeff ! coefficients per data point
38  integer :: ixdim,iydim ! fspl dimensions
39  ! =nx,ny unless zonal step function interpolation is used
40 
41  real*8 fspl(icoeff,ixdim,iydim) ! spline coefficients of f
42 c
43 c output:
44 c condition codes, =0 for normal exit
45 c
46  integer iwarn ! =1 if new grid points out of range
47  integer ier ! =1 if there is an argument error
48 c
49 c--------------------------------------------
50 c local
51 c
52  real*8 ytmp(nx_new)
53  integer ict(6)
54 c
55  data ict/1,0,0,0,0,0/
56 c
57 c--------------------------------------------
58 c
59  do iy=1,ny_new
60  ytmp=y_newgrid(iy)
61  call r8vecintrp2d(ict,nx_new,x_newgrid,ytmp,nx_new,f_new(1,iy),
62  > nx,xpkg,ny,ypkg,jspline,fspl,icoeff,ixdim,iydim,iwarn,ier)
63  enddo
64 c
65  return
66  end