1 subroutine mkintrp2d(x,nx,y,ny,jspline,
2 > f,icoeff,ixdim,iydim,
3 > ibcxmin,bcxmin,ibcxmax,bcxmax,
4 > ibcymin,bcymin,ibcymax,bcymax,
37 real f(icoeff,ixdim,iydim)
59 integer :: ii,imul,imin,imax,ickx,icky
60 integer :: idum1,idum2
63 real,
dimension(:,:),
allocatable :: wk2
72 imin=min(imin,jspline(ii))
73 imax=max(imax,jspline(ii))
74 if(jspline(ii).gt.0) imul=imul*2
77 if((imin.lt.-1).or.(imax.gt.2))
then
80 >
' ?mkintrp2d: spline type control out of range -1 to 2: ',
92 >
' ?mkintrp2d: spline/Hermite hybrid not supported (',
94 else if(imax.lt.1)
then
97 >
' ?mkintrp2d: zonal/linear hybrid not supported (',
103 if(imul.ne.icoeff)
then
105 >
' ?coeff dimension inconsistency for spline type codes ',
107 write(6,*)
' in mkintrp2d: expected: ',imul,
' got: ',icoeff
114 if(jspline(1).eq.-1)
then
120 if(jspline(2).eq.-1)
then
126 if((ickx.ne.ixdim).or.(icky.ne.iydim))
then
128 >
' ?mkintrp2d: dimensioning inconsistent with '//
129 >
'interpolation controls: ',jspline
130 write(6,*)
' expected: ',ickx,icky,
'; got: ',ixdim,iydim
135 if(jspline(1).le.0)
then
136 call splinck(x,nx,idum1,ztol,ier)
138 write(6,*)
' ?mkintrp2d: x axis not strict ascending.'
143 if(jspline(2).le.0)
then
144 call splinck(y,ny,idum1,ztol,ier)
146 write(6,*)
' ?mkintrp2d: y axis not strict ascending.'
156 if(jspline(1).eq.1)
then
157 if((min(ibcxmin,ibcxmax).lt.-1).or.
158 > (max(ibcxmin,ibcxmax).gt.1))
then
159 write(6,*)
' ?mkintrp2d: Bdy Cond code out of range for'
160 write(6,*)
' Hermite interpolation; (-1:1) allowed, '//
161 >
'found: ',ibcxmin,ibcxmax
166 if(ibcxmin.eq.-1)
then
168 else if((ibcxmin.eq.1).or.(ibcxmax.eq.1))
then
173 if(jspline(2).eq.1)
then
174 if((min(ibcymin,ibcymax).lt.-1).or.
175 > (max(ibcymin,ibcymax).gt.1))
then
176 write(6,*)
' ?mkintrp2d: Bdy Cond code out of range for'
177 write(6,*)
' Hermite interpolation; (-1:1) allowed, '//
178 >
'found: ',ibcymin,ibcymax
183 if(ibcymin.eq.-1)
then
185 else if((ibcymin.eq.1).or.(ibcymax.eq.1))
then
190 if(kspline.eq.1)
then
194 call util_bcherm2(f, ixdim, iydim,
195 > ibcxmin, ibcxmax, ibcymin, ibcymax,
196 > bcxmin, bcxmax, bcymin, bcymax,
199 call r8akherm2p(x,ixdim,y,iydim,
200 > f,ixdim,idum1,idum2,ipx,ipy,ier)
202 else if(kspline.eq.2)
then
205 call mkbicub(x,nx, y,ny, f,ixdim,
206 > ibcxmin,bcxmin,ibcxmax,bcxmax,
207 > ibcymin,bcymin,ibcymax,bcymax,
213 if(jspline(1).gt.0)
then
216 if(jspline(1).eq.1)
then
217 call util_bcherm1(f(1,1,ii), ixdim,
218 > ibcxmin, ibcxmax, bcxmin(ii), bcxmax(ii), x)
219 call akherm1p(x,ixdim,f(1,1,ii),idum1,ipx,ier)
221 else if(jspline(1).eq.2)
then
222 call mkspline(x,ixdim,f(1,1,ii),
223 > ibcxmin,bcxmin(ii), ibcxmax,bcxmax(ii),
234 wk2(1,1:iydim) = f(1,ii,1:iydim)
236 if(jspline(2).eq.1)
then
237 call util_bcherm1(wk2, iydim,
238 > ibcymin, ibcymax, bcymin(ii), bcymax(ii), y)
239 call akherm1p(y,iydim,wk2,idum2,ipy,ier)
241 else if(jspline(2).eq.2)
then
242 call mkspline(y,iydim,wk2,
243 > ibcymin,bcymin(ii), ibcymax,bcymax(ii),
248 f(1:2,ii,1:iydim) = wk2(1:2,1:iydim)