12 subroutine r8tpspline(x,inx,th,inth,ph,inph,fspl,inf4,inf5,
13 > wk,nwk,ilinx,ilinth,ilinph,ier)
16 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
17 integer inx,inth,inph,inf4,inf5,nwk
18 real*8 x(inx),th(inth),ph(inph)
19 real*8 fspl(4,4,4,inf4,inf5,inph),wk(nwk)
20 integer ilinx,ilinth,ilinph,ier
78 integer ierx,ierth,ierph
79 real*8 zdumth(inth),zdumx(inx)
83 if(nwk.lt.5*max(inx,inth,inph))
then
84 write(6,
'('' ?tpspline: workspace too small.'')')
88 write(6,
'('' ?tpspline: at least 2 x points required.'')')
92 write(6,
'('' ?tpspline: need at least 2 theta points.'')')
96 write(6,
'('' ?tpspline: need at least 2 phi points.'')')
102 call r8splinck(x,inx,ilinx,1.0e-3_r8,ierx)
106 write(6,
'('' ?tpspline: x axis not strict ascending'')')
111 call r8splinck(th,inth,ilinth,1.0e-3_r8,ierth)
115 write(6,
'('' ?tpspline: theta axis not strict ascending'')')
120 call r8splinck(ph,inph,ilinph,1.0e-3_r8,ierph)
124 write(6,
'('' ?tpspline: phi axis not strict ascending'')')
131 call r8tcspline(x,inx,th,inth,ph,inph,fspl,inf4,inf5,
132 > 7,zdumth,7,zdumth,inth,
133 > -1,zdumx,-1,zdumx,inx,
134 > -1,zdumx,-1,zdumx,inx,
135 > wk,nwk,ilinx,ilinth,ilinph,ier)