23 subroutine bcspline(x,inx,th,inth,fspl,inf3,
24 > ibcxmin,bcxmin,ibcxmax,bcxmax,
25 > ibcthmin,bcthmin,ibcthmax,bcthmax,
26 > wk,nwk,ilinx,ilinth,ier)
28 real x(inx),th(inth),fspl(4,4,inf3,inth),wk(nwk)
29 real bcxmin(*),bcxmax(*)
30 real bcthmin(*),bcthmax(*)
113 if(ibcthmin.ne.-1)
then
114 if((ibcthmin.eq.1).or.(ibcthmin.eq.2))
then
116 if (bcthmin(ix).ne.0.0) iflg2=1
119 if((ibcthmax.eq.1).or.(ibcthmax.eq.2))
then
121 if (bcthmax(ix).ne.0.0) iflg2=1
127 itest=5*max(inx,inth)
129 itest=itest +4*inx*inth
132 if(nwk.lt.itest)
then
133 write(6,9901) nwk,itest
134 9901
format(
' ?bcspline: workspace too small:'/
135 >
' user supplied: nwk=',i6,
'; need at least: ',i6/
136 >
' nwk=4*nx*ny +5*max(nx,ny) will work for any user'/
137 >
' choice of bdy conditions.')
141 write(6,
'('' ?bcspline: at least 2 x points required.'')')
145 write(6,
'('' ?bcspline: need at least 2 theta points.'')')
149 call ibc_ck(ibcxmin,
'bcspline',
'xmin',-1,7,ier)
150 if(ibcxmin.ge.0)
call ibc_ck(ibcxmax,
'bcspline',
'xmax',0,7,ier)
151 call ibc_ck(ibcthmin,
'bcspline',
'thmin',-1,7,ier)
152 if(ibcthmin.ge.0)
call ibc_ck(ibcthmax,
'bcspline',
'thmax',0,7,ier)
156 call splinck(x,inx,ilinx,1.0e-3,ierx)
160 write(6,
'('' ?bcspline: x axis not strict ascending'')')
165 call splinck(th,inth,ilinth,1.0e-3,ierth)
169 write(6,
'('' ?bcspline: th axis not strict ascending'')')
187 wk(4*(ix-1)+1)=fspl(1,1,ix,ith)
190 if(ibcxmin.eq.1)
then
192 else if(ibcxmin.eq.2)
then
196 if(ibcxmax.eq.1)
then
197 wk(inxo+2)=bcxmax(ith)
198 else if(ibcxmax.eq.2)
then
199 wk(inxo+3)=bcxmax(ith)
204 call v_spline(ibcxmin,ibcxmax,inx,x,wk,wk(4*inx+1))
209 fspl(2,1,ix,ith)=wk(4*(ix-1)+2)
210 fspl(3,1,ix,ith)=wk(4*(ix-1)+3)*xo2
211 fspl(4,1,ix,ith)=wk(4*(ix-1)+4)*xo6
230 wk(4*(ith-1)+1)=fspl(ic,1,ix,ith)
244 if((ibcthmin.eq.1).or.(ibcthmin.eq.2)) ibcthmina=0
245 if((ibcthmax.eq.1).or.(ibcthmax.eq.2)) ibcthmaxa=0
248 call v_spline(ibcthmina,ibcthmaxa,inth,th,wk,wk(4*inth+1))
253 fspl(ic,2,ix,ith)=wk(4*(ith-1)+2)
254 fspl(ic,3,ix,ith)=wk(4*(ith-1)+3)*xo2
255 fspl(ic,4,ix,ith)=wk(4*(ith-1)+4)*xo6
274 zhth=th(inth)-th(inth-1)
281 if(ibcthmin.eq.1) iselect1(3)=1
282 if(ibcthmin.eq.2) iselect1(5)=1
283 if(ibcthmax.eq.1) iselect2(3)=1
284 if(ibcthmax.eq.2) iselect2(5)=1
292 if(ibcthmin.eq.1)
then
294 zcur(1)=fspl(1,2,ix,1)
296 zcur(1)=fspl(1,2,jx,1)+zhxn*(fspl(2,2,jx,1)+zhxn*
297 > (fspl(3,2,jx,1)+zhxn*fspl(4,2,jx,1)))
299 zdiff1=bcthmin(ix)-zcur(1)
300 else if(ibcthmin.eq.2)
then
302 zcur(1)=2.0*fspl(1,3,ix,1)
305 > (fspl(1,3,jx,1)+zhxn*(fspl(2,3,jx,1)+zhxn*
306 > (fspl(3,3,jx,1)+zhxn*fspl(4,3,jx,1))))
308 zdiff1=bcthmin(ix)-zcur(1)
315 if(ibcthmax.eq.1)
then
319 > fspl(1,2,ix,jth)+zhth*(2.0*fspl(1,3,ix,jth)+
320 > zhth*3.0*fspl(1,4,ix,jth))
322 call bcspeval(x(inx),th(inth),iselect2, zcur,
323 > x,inx,th,inth,ilinx,ilinth,fspl,inf3,ier)
326 zdiff2=bcthmax(ix)-zcur(1)
327 else if(ibcthmax.eq.2)
then
330 zcur(1)=2.0*fspl(1,3,ix,jth)+
331 > 6.0*zhth*fspl(1,4,ix,jth)
333 call bcspeval(x(inx),th(inth),iselect2, zcur(1),
334 > x,inx,th,inth,ilinx,ilinth,fspl,inf3,ier)
337 zdiff2=bcthmax(ix)-zcur(1)
346 iadr=iasc+(ix-1)*iinc
348 wk(iadr+4*(ith-1))=0.0
356 if(ibcthmin.eq.1)
then
358 else if(ibcthmin.eq.2)
then
362 if(ibcthmax.eq.1)
then
363 wk(iadr+intho+1)=zdiff2
364 else if(ibcthmax.eq.2)
then
365 wk(iadr+intho+2)=zdiff2
368 call v_spline(ibcthmin,ibcthmax,inth,th,wk(iadr),wk(iawk))
374 iadr=iasc+(ix-1)*iinc
376 wk(iadr+4*(ith-1)+2)=wk(iadr+4*(ith-1)+2)*xo2
377 wk(iadr+4*(ith-1)+3)=wk(iadr+4*(ith-1)+3)*xo6
379 fspl(1,2,ix,ith)=fspl(1,2,ix,ith)+wk(iadr+4*(ith-1)+1)
380 fspl(1,3,ix,ith)=fspl(1,3,ix,ith)+wk(iadr+4*(ith-1)+2)
381 fspl(1,4,ix,ith)=fspl(1,4,ix,ith)+wk(iadr+4*(ith-1)+3)
393 iaspl=iasc+iinc*(ix-1)
394 wk(iawk+4*(ix-1))=wk(iaspl+4*(ith-1)+(ic-1))
407 call v_spline(ibcxmin,ibcxmax,inx,x,wk(iawk),wk(ia5w))
410 fspl(2,ic,ix,ith)=fspl(2,ic,ix,ith)+
411 > wk(iawk+4*(ix-1)+1)
412 fspl(3,ic,ix,ith)=fspl(3,ic,ix,ith)+
413 > wk(iawk+4*(ix-1)+2)*xo2
414 fspl(4,ic,ix,ith)=fspl(4,ic,ix,ith)+
415 > wk(iawk+4*(ix-1)+3)*xo6