7 subroutine r8tpsplinb(x,inx,th,inth,ph,inph,fspl,inf4,inf5,
8 > ibcxmin,bcxmin,ibcxmax,bcxmax,inb1,
9 > wk,nwk,ilinx,ilinth,ilinph,ier)
12 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
13 integer inx,inth,inph,inf4,inf5,nwk,inb1
14 real*8 x(inx),th(inth),ph(inph)
15 real*8 fspl(4,4,4,inf4,inf5,inph),wk(nwk)
16 integer ibcxmin,ibcxmax
17 real*8 bcxmin(inb1,inph),bcxmax(inb1,inph)
18 integer ilinx,ilinth,ilinph,ier
96 integer ierx,ierth,ierph
101 if(nwk.lt.5*max(inx,inth,inph))
then
102 write(6,
'('' ?tpsplinb: workspace too small.'')')
106 write(6,
'('' ?tpsplinb: at least 2 x points required.'')')
110 write(6,
'('' ?tpsplinb: need at least 2 theta points.'')')
114 write(6,
'('' ?tpsplinb: need at least 2 phi points.'')')
118 if((ibcxmin.eq.1).or.(ibcxmax.eq.1).or.(ibcxmin.eq.2).or.
119 > (ibcxmax.eq.2))
then
120 if(inb1.lt.inth)
then
123 >
'('.lt.
' ?tpsplinb: 1st dim of bcxmin/max arrays inth'')')
127 call ibc_ck(ibcxmin,
'tpsplinb',
'xmin',0,7,ier)
128 call ibc_ck(ibcxmax,
'tpsplinb',
'xmax',0,7,ier)
132 call r8splinck(x,inx,ilinx,1.0e-3_r8,ierx)
136 write(6,
'('' ?tpsplinb: x axis not strict ascending'')')
141 call r8splinck(th,inth,ilinth,1.0e-3_r8,ierth)
145 write(6,
'('' ?tpsplinb: theta axis not strict ascending'')')
150 call r8splinck(ph,inph,ilinph,1.0e-3_r8,ierph)
154 write(6,
'('' ?tpsplinb: phi axis not strict ascending'')')
161 call r8tcspline(x,inx,th,inth,ph,inph,fspl,inf4,inf5,
162 > ibcxmin,bcxmin,ibcxmax,bcxmax,inb1,
163 > -1,zdumx,-1,zdumx,inx,
164 > -1,zdumx,-1,zdumx,inx,
165 > wk,nwk,ilinx,ilinth,ilinph,ier)