1 subroutine r8genxpkg(nx,x,xpkg,iper,imsg,itol,ztol,ialg,ier)
58 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
59 INTEGER ialgu,iabs,ix,ixp,itest,i
62 real*8 ztolr,ztola,zh,xtest
92 write(6,*) .ge.
' %genxpkg: nx2 required!'
100 if(ialgu.eq.0) ialgu=3
101 if(iabs(ialgu).gt.3) ialgu=3
111 ztola=max(abs(x(1)),abs(x(nx)))*ztolr
143 xpkg(nx,2)=(x(nx)-x(1))/(nx-1)
147 if((ier.eq.0).and.(ix.lt.nx))
then
148 if(x(ix+1).le.x(ix))
then
150 write(6,*)
' %genxpkg: x axis not strict ascending!'
157 if(abs(zh-xpkg(nx,2)).gt.ztola) xpkg(3,4)=1.0_r8
171 xpkg(nx,3)=1.0_r8/xpkg(nx,2)
178 if(xpkg(3,4).eq.0.0_r8)
then
181 xpkg(ixp,1)=xpkg(1,1)+ix*xpkg(nx,2)
194 if(xpkg(3,4).ne.0.0_r8)
then
204 if(abs(ialgu).eq.3)
then
212 xtest=xtest+xpkg(nx,2)
214 if((xpkg(itest,1).le.xtest).and.
215 > (xtest.le.xpkg(itest+1,1)))
then
216 xpkg(i,2)=itest+(xtest-xpkg(itest,1))/
217 > (xpkg(itest+1,1)-xpkg(itest,1))