! 07Jun1999 fgtok -impno -s r8_precision.sub r8_names.table "r8con.csh conversion"
      subroutine r8cubsplb(tau, c, n, ibcbeg, ibcend)
C...Translated by Pacific-Sierra Research VAST-90 2.06G2  10:50:51  10/ 1/01  
C...Switches: -p4 -yb
      use kind_spec

      implicit none
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      integer n, ibcbeg, ibcend
      real(kind=dp), dimension(n) :: tau
      real(kind=dp), dimension(4,n) :: c
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: j1, j2, i, j, l, m
      real(kind=dp) :: divdf1, divdf3, dtau, g
C-----------------------------------------------
c
c
c****** a tridiagonal linear system for the unknown slopes s(i) of
c  f  at tau(i), i=1,...,n, is generated and then solved by gauss elim-
c  ination, with s(i) ending up in c(2,i), all i.
c     c(3,.) and c(4,.) are used initially for temporary storage.
      l = n - 1
compute first differences of tau sequence and store in c(3,.). also,
compute first divided difference of data and store in c(4,.).
      c(3,2:n) = tau(2:n) - tau(:n-1)
      c(4,2:n) = (c(1,2:n)-c(1,:n-1))/c(3,2:n)
construct first equation from the boundary condition, of the form
c             c(4,1)*s(1) + c(3,1)*s(2) = c(2,1)
      if (ibcbeg - 1 <= 0) then
         if (ibcbeg - 1 /= 0) then
            if (n <= 2) then
c     no condition at left end and n = 2.
               c(4,1) = 1.E0_dp
               c(3,1) = 1.E0_dp
               c(2,1) = 2.E0_dp*c(4,2)
               go to 25
c     not-a-knot condition at left end and n .gt. 2.
            endif
            c(4,1) = c(3,3)
            c(3,1) = c(3,2) + c(3,3)
            c(2,1) = ((c(3,2)+2.E0_dp*c(3,1))*c(4,2)*c(3,3)
     1         +c(3,2)**2*c(4,3))/c(3,1)
            go to 19
c     slope prescribed at left end.
         endif
         c(4,1) = 1.E0_dp
         c(3,1) = 0.E0_dp
      else
c     second derivative prescribed at left end.
         c(4,1) = 2.E0_dp
         c(3,1) = 1.E0_dp
         c(2,1) = 3.E0_dp*c(4,2) - c(3,2)/2.E0_dp*c(2,1)
      endif
      if (n == 2) go to 25
c  if there are interior knots, generate the corresp. equations and car-
c  ry out the forward pass of gauss elimination, after which the m-th
c  equation reads    c(4,m)*s(m) + c(3,m)*s(m+1) = c(2,m).
   19 continue
      do m = 2, l
         g = -c(3,m+1)/c(4,m-1)
         c(2,m) = g*c(2,m-1) + 3.E0_dp*(c(3,m)*c(4,m+1)+c(3,m+1)*c(4,m))
         c(4,m) = g*c(3,m-1) + 2.E0_dp*(c(3,m)+c(3,m+1))
      end do
construct last equation from the second boundary condition, of the form
c           (-g*c(4,n-1))*s(n-1) + c(4,n)*s(n) = c(2,n)
c     if slope is prescribed at right end, one can go directly to back-
c     substitution, since c array happens to be set up just right for it
c     at this point.
      if (ibcend - 1 > 0) go to 24
      if (ibcend - 1 == 0) go to 30
      if (n==3 .and. ibcbeg==0) go to 22
c     not-a-knot and n .ge. 3, and either n.gt.3 or  also not-a-knot at
c     left end point.
      g = c(3,n-1) + c(3,n)
      c(2,n) = ((c(3,n)+2.E0_dp*g)*c(4,n)*c(3,n-1)
     1 +c(3,n)**2*(c(1,n-1)-c(1,n-2))/c(3,n-1))/g
      g = -g/c(4,n-1)
      c(4,n) = c(3,n-1)
      go to 29
c     either (n=3 and not-a-knot also at left) or (n=2 and not not-a-
c     knot at left end point).
   22 continue
      c(2,n) = 2.E0_dp*c(4,n)
      c(4,n) = 1.E0_dp
      go to 28
c     second derivative prescribed at right endpoint.
   24 continue
      c(2,n) = 3.E0_dp*c(4,n) + c(3,n)/2.E0_dp*c(2,n)
      c(4,n) = 2.E0_dp
      go to 28
   25 continue
      if (ibcend - 1 > 0) go to 24
      if (ibcend - 1 == 0) go to 30
      if (ibcbeg > 0) go to 22
c     not-a-knot at right endpoint and at left endpoint and n = 2.
      c(2,n) = c(4,n)
      go to 30
   28 continue
      g = -1.E0_dp/c(4,n-1)
complete forward pass of gauss elimination.
   29 continue
      c(4,n) = g*c(3,n-1) + c(4,n)
      c(2,n) = (g*c(2,n-1)+c(2,n))/c(4,n)
carry out back substitution
   30 continue
      j = l
      j1 = j
      j2 = min0(1,j1)
      do j = j1, j2, -1
         c(2,j) = (c(2,j)-c(3,j)*c(2,j+1))/c(4,j)
      end do
c****** generate cubic coefficients in each interval, i.e., the deriv.s
c  at its left endpoint, from value and slope at its endpoints.
      do i = 2, n
         dtau = c(3,i)
         divdf1 = (c(1,i)-c(1,i-1))/dtau
         divdf3 = c(2,i-1) + c(2,i) - 2.E0_dp*divdf1
         c(3,i-1) = 2.E0_dp*(divdf1 - c(2,i-1)-divdf3)/dtau
         c(4,i-1) = (divdf3/dtau)*(6.E0_dp/dtau)
      end do
c
      return 
      end subroutine r8cubsplb
