c---------------------------------------
c-
c- file: icsicu.f
c-
c- purpose: replaces imsl routine icsicu
c-
c----------------------------------------
       subroutine icsicu(x, y, nx, bpar, c, ic, ier)
c
c-- x(nx) x values for data points, must satisfy x(i) < x(i+1)
c-- y(nx) y values
c-- nx - number of points
c-- bpar(4) end condition parameters
c       2*s''(1) + bpar(1) == bpar(2)
c       bpar(3)*s''(nx-1) + 2*s''(nx) = bpar(4)
c-- c(ic, 3) - spline coefficients c(nx-1,3)
c--     s(t) = ((c(i,3)*d+c(i,2)*d)+c(i,1)*d + y(i)
c---        d = t - x(i)
c-- ic - row dim of c
c-- ier - error codes:
c
c      ier = 129 for ic < nx-1
c      ier = 130 for nx < 2
c      ier = 131 for unorder x's
c----------------------------------------------
      implicit none
      integer nx, ic, ier
      real*8 x(nx), y(nx), bpar(4), c(ic,3)
      real*8 dxj, dyj, dxjp1, dyjp1, dxp, dx
      real*8 yppa, yppb, pj
      integer j, i
      integer nxm1
      ier = 0
      nxm1 = nx-1
c--- test that x values are ordered and input sane
      do j=2, nxm1
        if(x(j+1).le.x(j)) then
           ier = 133
        endif
      end do
      if( nx .lt. 2) then
        ier = 130
      end if
      if( ic < nxm1) then
        ier = 129
      endif
      if( ier .ne. 0) then
        call uertst(ier, 6hicsicu)
        return
      endif
c--- if nx bigger than 2, setup tridiagonal matrix
      if( nx .gt. 2 ) then
        dxj = x(2) - x(1)
        dyj = y(2) - y(1)
        do j=2, nxm1
          dxjp1 = x(j+1)-x(j)
          dyjp1 = y(j+1)-y(j)
          dxp = dxj+ dxjp1
          c(j,1) = dxjp1/dxp
          c(j,2) = 1.0-c(j,1)
          c(j,3) = 6.0*(dyjp1/dxjp1 - dyj/dxj)/dxp
          dxj = dxjp1
          dyj = dyjp1
        end do
      end if
c--- solve
      c(1,1) = -bpar(1)*0.5
      c(1,2) =  bpar(2)*0.5
      if(nx .gt. 2) then
        do j=2, nxm1
          pj = c(j,2)*c(j-1,1) + 2.0
          c(j,1)= -c(j,1)/pj
          c(j,2) = (c(j,3) - c(j,2)*c(j-1,2))/pj
        end do
      end if
c--- back substitution
      yppb = (bpar(4)-bpar(3)*c(nxm1,2))/(bpar(3)*c(nxm1,1)+2.0)
      do i=1, nxm1
        j= nx - i
        yppa = c(j,1)*yppb+c(j,2)
        dx = x(j+1)-x(j)
        c(j,3) = (yppb-yppa)/(6.0*dx)
        c(j,2) = 0.5*yppa
        c(j,1) = (y(j+1)-y(j))/dx-(c(j,2)+c(j,3)*dx)*dx
        yppb = yppa
      end do
      return
      end
