1 subroutine r8mkbicubw(x,nx,y,ny,f,nf2,
2 > ibcxmin,bcxmin,ibcxmax,bcxmax,
3 > ibcymin,bcymin,ibcymax,bcymax,
16 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
17 INTEGER itest,iadfp,isiz1,iadfw,inwk
140 data iselect/-1,0,0,0,0,0,0,0,0,0/
145 if(nwk.lt.itest)
then
146 write(6,9901) nwk,itest
147 9901
format(
' ?mkbicubw: workspace too small:'/
148 >
' user supplied: nwk=',i7,
'; need at least: ',i7/
149 >
' nwk = at least 21*nx*ny is required.')
159 call r8mkbicop(f,nf2,wk(iadfp),nx,ny)
163 call r8bcspline(x,nx,y,ny,wk(iadfp),nx,
164 > ibcxmin,bcxmin,ibcxmax,bcxmax,
165 > ibcymin,bcymin,ibcymax,bcymax,
175 call r8mkbicon(f,nf2,wk(iadfp),nx,ny,hxlast,hylast)
183 subroutine r8mkbicop(fin,nf2,fwk,nx,ny)
188 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
189 INTEGER nx,ny,nf2,iy,ix
192 real*8 fwk(4,4,nx,ny)
196 fwk(1,1,ix,iy)=fin(1,ix,iy)
206 subroutine r8mkbicon(fin,nf2,fwk,nx,ny,hxlast,hylast)
211 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
212 INTEGER nx,ny,nf2,iy,ix,iflag,ixuse,iyuse,j
215 real*8 hxlast,hylast,dxuse,dyuse
218 real*8 fwk(4,4,nx,ny)
226 data iselect/-1,0,0,0,0,0,0,0,0,0/
252 call r8bcspevfn(iselect,1,1,zvalues,
253 > ixuse,iyuse,dxuse,dyuse,
256 fin(j,ix,iy)=zvalues(j)
259 fin(2,ix,iy)=2.0_r8*fwk(3,1,ix,iy)
260 fin(3,ix,iy)=2.0_r8*fwk(1,3,ix,iy)
261 fin(4,ix,iy)=4.0_r8*fwk(3,3,ix,iy)