c----------------------
      subroutine dbcevl(x, nx, y, ny, sc, ic, xp, yp, pds, ierr)
C...Translated by Pacific-Sierra Research VAST-90 2.06G2  10:50:51  10/ 1/01  
C...Switches: -p4 -yb
      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer nx, ny, ic, ierr
      real*8 xp, yp
      real*8, dimension(*) :: x, y
      real*8, dimension(2,ic,*) :: sc
      real*8, dimension(6) :: pds
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: i, j, k, km1, kp1, kp2, l, lxp1, lxpl, lx, ly
      real*8 :: d, h, hx, hy, s0, sh, sp0, sph
      real*8, dimension(2) :: su, sux, suy, sv, svx, sxy
      real*8 :: u, v
      character :: isub*6 = 'dbcevl'
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      real*8 spln0, spln1, spln2
C-----------------------------------------------
      data lx, ly/2*0/
c
c
c--Correlated table search for xp
c
      ierr = 0
      call tableintrp (x, nx, xp, lx)
      if (lx == 0) then
         ierr = 33
         go to 9000
      else if (lx == nx) then
         ierr = 35
         go to 9000
      endif
c
c--Correlated table search for yp
c
      call tableintrp (y, ny, yp, ly)
      if (ly == 0) then
         ierr = 34
         go to 9000
      else if (ly == ny) then
         ierr = 36
         go to 9000
      endif
c
      lxp1 = lx + 1
      hx = x(lxp1) - x(lx)
      hy = y(ly+1) - y(ly)
      u = (xp - x(lx))/hx
      v = (yp - y(ly))/hy
      k = 2*ly
      kp1 = k + 1
      kp2 = k + 2
      km1 = k - 1
c
      do l = 1, 2
         lxpl = lx - 1 + l
         i = 2*(ly - 1 + l)
         j = i - 1
         sv(l) = spln0(sc(1,lxpl,km1),sc(1,lxpl,kp1),sc(1,lxpl,k),sc(1,
     1      lxpl,kp2),hy,v)
         svx(l) = spln0(sc(2,lxpl,km1),sc(2,lxpl,kp1),sc(2,lxpl,k),sc(2,
     1      lxpl,kp2),hy,v)
         su(l) = spln0(sc(1,lx,j),sc(1,lxp1,j),sc(2,lx,j),sc(2,lxp1,j),
     1      hx,u)
         suy(l) = spln0(sc(1,lx,i),sc(1,lxp1,i),sc(2,lx,i),sc(2,lxp1,i),
     1      hx,u)
         sux(l) = spln1(sc(1,lx,j),sc(1,lxp1,j),sc(2,lx,j),sc(2,lxp1,j),
     1      hx,u)
         sxy(l) = spln1(sc(1,lx,i),sc(1,lxp1,i),sc(2,lx,i),sc(2,lxp1,i),
     1      hx,u)
      end do
c
      pds(1) = spln0(sv(1),sv(2),svx(1),svx(2),hx,u)
      pds(2) = spln1(sv(1),sv(2),svx(1),svx(2),hx,u)
      pds(3) = spln1(su(1),su(2),suy(1),suy(2),hy,v)
      pds(4) = spln1(sux(1),sux(2),sxy(1),sxy(2),hy,v)
      pds(5) = spln2(sv(1),sv(2),svx(1),svx(2),hx,u)
      pds(6) = spln2(su(1),su(2),suy(1),suy(2),hy,v)
      go to 9990
c
c--Error exit.
c
 9000 continue
      call uertst (ierr, isub)
c
c--Normal exit.
c
 9990 continue
      return 
      contains
      real*8 function spln0 (s0, sh, sp0, sph, h, d)
      real*8 s0
      real*8 sh
      real*8 sp0
      real*8 sph
      real*8 h
      real*8 d
      spln0 = s0 + d*(h*sp0 + d*(3.0*(sh - s0) - (sph + 2.0*sp0)*h + d*(
     1   2.0*(s0 - sh) + (sph + sp0)*h)))
      return 
      end function spln0
      real*8 function spln1 (s0, sh, sp0, sph, h, d)
      real*8 s0
      real*8 sh
      real*8 sp0
      real*8 sph
      real*8 h
      real*8 d
      spln1 = sp0 + d*(6.0*(sh - s0)/h - 2.0*(sph + 2.0*sp0) + 3.0*d*(
     1   2.0*(s0 - sh)/h + (sph + sp0)))
      return 
      end function spln1
      real*8 function spln2 (s0, sh, sp0, sph, h, d)
      real*8 s0
      real*8 sh
      real*8 sp0
      real*8 sph
      real*8 h
      real*8 d
      spln2 = 6.0*(sh - s0)/h**2 - 2.0*(sph + 2.0*sp0)/h + d*(2.0*(s0 - 
     1   sh)/h**2 + (sph + sp0)/h)*6.
      return 
      end function spln2
      end subroutine dbcevl
