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...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 nx, ic, ier
      real(kind=dp), dimension(nx) :: x, y
      real(kind=dp), dimension(4) :: bpar
      real(kind=dp), dimension(ic,3) :: c
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: j, i, nxm1
      real(kind=dp) :: dxj, dyj, dxjp1, dyjp1, dxp, dx, yppa, yppb, 
     1   pj
C-----------------------------------------------
      ier = 0
      nxm1 = nx - 1
c--- test that x values are ordered and input sane
      do j = 2, nxm1
         if (x(j+1) <= x(j)) ier = 133
      end do
      if (nx < 2) ier = 130
      if (ic < nxm1) ier = 129
      if (ier /= 0) then
         call uertst (ier, 6Hicsicu)
         return 
      endif
c--- if nx bigger than 2, setup tridiagonal matrix
      if (nx > 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
      endif
c--- solve
      c(1,1) = -bpar(1)*0.5
      c(1,2) = bpar(2)*0.5
      if (nx > 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
      endif
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 subroutine icsicu
