1 subroutine r8herm1ev(xget,x,nx,ilinx,f,ict,fval,ier)
15 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
74 call r8herm1x(xget,x,nx,ilinx,i,xparam,hx,hxi,ier)
77 call r8herm1fcn(ict,1,1,fval,i,xparam,hx,hxi,f,nx)
86 subroutine r8herm1x(xget,x,nx,ilinx,i,xparam,hx,hxi,ier)
94 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
133 if((xget.lt.x(1)).or.(xget.gt.x(nx)))
then
134 zxtol=4.0e-7_r8*max(abs(x(1)),abs(x(nx)))
135 if((xget.lt.x(1)-zxtol).or.(xget.gt.x(nx)+zxtol))
then
137 write(6,1001) xget,x(1),x(nx)
138 1001
format(
' ?herm1ev: xget=',1pe11.4,
' out of range ',
139 > 1pe11.4,
' to ',1pe11.4)
141 if((xget.lt.x(1)-0.5_r8*zxtol).or.
142 > (xget.gt.x(nx)+0.5_r8*zxtol))
143 >
write(6,1011) xget,x(1),x(nx)
144 1011
format(
' %herm1ev: xget=',1pe15.8,
' beyond range ',
145 > 1pe15.8,
' to ',1pe15.8,
' (fixup applied)')
146 if(xget.lt.x(1))
then
160 ii=1+nxm*(zxget-x(1))/(x(nx)-x(1))
162 if(zxget.lt.x(i))
then
164 else if(zxget.gt.x(i+1))
then
168 if((1.le.i).and.(i.lt.nxm))
then
169 if((x(i).le.zxget).and.(zxget.le.x(i+1)))
then
172 call r8zonfind(x,nx,zxget,i)
176 call r8zonfind(x,nx,zxget,i)
184 xparam=(zxget-x(i))*hxi
192 subroutine r8herm1fcn(ict,ivec,ivecd,
193 > fval,ii,xparam,hx,hxi,fin,nx)
200 INTEGER,
PARAMETER :: R8=selected_real_kind(12,100)
204 real*8 xp,xpi,xp2,xpi2,ax,axbar,bx,bxbar,axp,axbarp,bxp,bxbarp
277 ax=xp2*(3.0_r8-2.0_r8*xp)
282 sum=axbar*fin(0,i) + ax*fin(0,i+1)
284 sum=sum+hx(v)*(bxbar*fin(1,i) + bx*fin(1,i+1))
297 bxp=xp*(3.0_r8*xp-2.0_r8)
298 bxbarp=xpi*(3.0_r8*xpi-2.0_r8)
300 sum=hxi(v)*(axbarp*fin(0,i) +axp*fin(0,i+1))
302 sum=sum+ bxbarp*fin(1,i) + bxp*fin(1,i+1)