
      subroutine dbcevl1 (x, nx, y, ny, c, ic, xl, yl, pds, ier, icalc)
c
      implicit  integer (i-n), real*8 (a-h, o-z)
c
c --- this is a special version of dbcevl, used by the ONETWO suite
c --- of subroutines. It differs from the IMSL version in the calling
c --- arguments and the calculations below are reordered for efficiency
c --- That is, many times we don't need all of the pds array. This
c --- version returns only those values of pds specifically requested
c --- using the argument icalc. This leads to about at 50% improvement
c --- in execution time. --- HSJ
c
      integer  nx,ny,ic,ier,i,j,k,km1,kp1,kp2,lxpl,lx,ly,l,lxp1
      real*8   x(*),y(*),c(2,ic,*),xl,yl,pds(6),
     .         hx,hy,sux(2),suy(2),su(2),svx(2),sv(2),sxy(2),
     .         u,v,spln0,spln1,spln2,s0,sh,sp0,sph,h,d
c
      spln0(s0,sh,sp0,sph,h,d) = s0+d*(h*sp0+d*(3.0*(sh-s0)-
     . (sph+2.0*sp0)*h+d*(2.0*(s0-sh)+(sph+sp0)*h)))
c
      spln1(s0,sh,sp0,sph,h,d) = sp0+d*(6.0 * (sh-s0)/h-2.0*
     . (sph+2.0*sp0)+3.0*d*(2.0*(s0-sh)/h+(sph+sp0)))
c
      spln2(s0,sh,sp0,sph,h,d) = 6.0 * (sh-s0)/h**2-2.0*
     . (sph+2.0*sp0)/h+d*(2.0*(s0-sh)/h**2+(sph+sp0)/h)*6.
c
      data  lx, ly /0, 0/
c
      ier = 0
c
c --- correlated table search for xl
c
      call tableintrp (x, nx, xl, lx)
      if (lx  .eq. 0 )  ier = 33
      if (lx  .eq. nx)  ier = 35
      if (ier .ne. 0 )  go to 100
c
c --- correlated table search for yl
c
      call tableintrp (y, ny, yl, ly)
      if ( ly .eq. 0 )  ier = 34
      if ( ly .eq. ny)  ier = 36
      if (ier .ne. 0 )  go to 100
c
c --- replaces the following linear search
c
****  if (xl .lt. x(1))  ier = 33
****  do 5 i=2,nx
****     lx = i-1
****     if (xl .le. x(i))  go to 10
****5 continue
****  ier = 35
***10 if (yl .lt. y(1))  ier = 34
****  do 15 j=2,ny
****     ly = j-1
****     if (yl .le. y(j))  go to 20
***15 continue
****  ier = 36
***20 if (ier .ne. 0)  go to 100
c
      lxp1 = lx+1
      hx   = x(lxp1)-x(lx)
      hy   = y(ly+1)-y(ly)
      u    = (xl-x(lx))/hx
      v    = (yl-y(ly))/hy
      k    = 2*ly
      kp1  = k+1
      kp2  = k+2
      km1  = k-1
c
      do 25 l=1,2
         lxpl = lx-1+l
         i    = 2*(ly-1+l)
         j    = i-1
         sv(l) = spln0(c(1,lxpl,km1),c(1,lxpl,kp1),c(1,lxpl,k),
     .   c(1,lxpl,kp2),hy,v)
         svx(l) = spln0(c(2,lxpl,km1),c(2,lxpl,kp1),c(2,lxpl,k),
     .   c(2,lxpl,kp2),hy,v)
      if (icalc .lt. 3)  go to 25                    ! rearranged by HSJ
         su(l) = spln0(c(1,lx,j),c(1,lxp1,j),c(2,lx,j),
     .   c(2,lxp1,j),hx,u)
         suy(l) = spln0(c(1,lx,i),c(1,lxp1,i),c(2,lx,i),
     .   c(2,lxp1,i),hx,u)
      if (icalc .lt. 4)  go to 25
         sux(l) = spln1(c(1,lx,j),c(1,lxp1,j),c(2,lx,j),
     .   c(2,lxp1,j),hx,u)
         sxy(l) = spln1(c(1,lx,i),c(1,lxp1,i),c(2,lx,i),
     .   c(2,lxp1,i),hx,u)
   25 continue
c
      pds(1) = spln0(sv(1),sv(2),svx(1),svx(2),hx,u)
      if (icalc .eq. 1)  return ! special routine only calculates pds(1)
      pds(2) = spln1(sv(1),sv(2),svx(1),svx(2),hx,u)
      if (icalc .eq. 2)  return
      pds(3) = spln1(su(1),su(2),suy(1),suy(2),hy,v)
      if (icalc .eq. 3)  return
      pds(4) = spln1(sux(1),sux(2),sxy(1),sxy(2),hy,v)
      if (icalc .eq. 4)  return
      pds(5) = spln2(sv(1),sv(2),svx(1),svx(2),hx,u)
      if (icalc .eq. 5)  return
      pds(6) = spln2(su(1),su(2),suy(1),suy(2),hy,v)
  100 if (ier .gt. 0) then
****    call uertst1 (ier, 'dbcevl')
      end if
      return
c
      end
