subroutine cubspl4(n,tau,c0,c1,c2,c3,ibcbeg,ibcend,error)
  use gbl_message
  use greg_interfaces, except_this=>cubspl4
  !---------------------------------------------------------------------
  ! @ public
  !  Piecewise cubic spline interpolants computation; adapted from
  !  'A practical guide to SPLINES' , CARL DE BOOR, Applied Mathematical
  !  Sciences, SPRINGER-VERLAG, VOL.27, P57-59 (1978).
  !
  !  c1(1), c1(N) are boundary condition information. Specifically:
  !
  !  IBCBEG = 0 means no boundary condition at tau(1) is given. In this
  !             case, the not-a-knot condition is used, i.e. the jump in
  !             the third derivative across TAU(2) is forced to zero,
  !             thus the first and the second cubic polynomial pieces
  !             are made to coincide.
  !  IBCBEG = 1 means that the slope at TAU(1) is made to equal c1(1),
  !             supplied by input.
  !  IBCBEG = 2 means that the second derivative at TAU(1) is made to
  !             equal c1(1), supplied by input.
  !
  !  IBCEND = 0, 1, or 2 has analogous meaning concerning the boundary
  !             condition at TAU(N), with the additional information
  !             taken from c1(N).
  !
  !  CJ(I), J=1,...,4; I=1,...,L (= N-1) are the polynomial coefficients
  !  of the cubic interpolating spline. Precisely, in the interval
  !  [ TAU(I), TAU(I+1) ]  the spline F is given by
  !         F(X) = c0(I)+H*(c1(I)+H*(c2(I)+H*c3(I)/3.)/2.)
  !  where H = X - TAU(I).
  !
  !  In other words, for I=1,...,N, c1(I) and c2(I) are respectively
  !  equal to the values of the first and second derivatives of the
  !  interpolating spline, and c3(I) is equal to the third derivative
  !  of the interpolating spline in the interval [ TAU(I), TAU(I+1) ].
  !  c3(N) is meaningless and is set to 0.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n       ! Number of data points (>1)
  real(kind=4),    intent(in)    :: tau(n)  ! Abscissae of data points, strictly monotonous
  real(kind=4),    intent(inout) :: c0(n)   ! Ordinates of data points (in) / First polynomial coefficient of spline (out)
  real(kind=4),    intent(inout) :: c1(n)   ! Boundary condition information (in) / Second polynomial coefficient of spline (out)
  real(kind=4),    intent(out)   :: c2(n)   ! Third polynomial coefficient of spline
  real(kind=4),    intent(out)   :: c3(n)   ! Fourth polynomial coefficient of spline
  integer(kind=4), intent(in)    :: ibcbeg  ! Boundary condition indicator
  integer(kind=4), intent(in)    :: ibcend  ! Boundary condition indicator
  logical,         intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CUBSPL4'
  real(kind=4) :: taum1,g,dtau,divdf1,divdf3
  integer(kind=4) :: i,j,l,m
  !
  ! A tridiagonal linear system for the unknown slopes S(I) of
  ! F at TAU(I), I=1,...,N, is generated and then solved by gauss
  ! elimination, with S(I) ending up in c1(I), all I.
  ! c2(.) and c3(.) are used initially for temporary storage.
  !
  if (n.lt.2) then
    call greg_message(seve%e,rname,'Less than two pivots')
    error = .true.
    return
  endif
  !
  ! Check if TAU strictly monotonous
  taum1=tau(2)
  if (tau(2).lt.tau(1)) then
    do i=3,n
      if (tau(i).ge.taum1) then
        call greg_message(seve%e,rname,'Variable is not strictly monotonous')
        error = .true.
        return
      endif
      taum1 = tau(i)
    enddo
  elseif (tau(2).gt.tau(1)) then
    do i=3,n
      if (tau(i).le.taum1) then
        call greg_message(seve%e,rname,'Variable is not strictly monotonous')
        error = .true.
        return
      endif
      taum1 = tau(i)
    enddo
  else
    call greg_message(seve%e,rname,'Variable is not strictly monotonous')
    error = .true.
    return
  endif
  !
  l = n-1
  !
  ! Compute first differences of TAU sequence and store in c2(.).
  ! Also, compute first divided difference of data and store in c3(.).
  !
  do  m=2,n
    c2(m) = tau(m) - tau(m-1)
    c3(m) = (c0(m) - c0(m-1))/c2(m)
  enddo
  !
  ! Construct first equation from the boundary condition, of the form
  !             c3(1)*S(1) + c2(1)*S(2) = c1(1)
  !
  if (ibcbeg-1)                     11,15,16
11 if (n .gt. 2)                     goto 12
  !
  ! No condition at left end and N = 2.
  c3(1) = 1.
  c2(1) = 1.
  c1(1) = 2.*c3(2)
  goto 25
  !
  ! Not-a-knot condition at left end and N .GT. 2.
12 c3(1) = c2(3)
  c2(1) = c2(2) + c2(3)
  c1(1) = ((c2(2)+2.*c2(1))*c3(2)*c2(3)+c2(2)**2*c3(3))/c2(1)
  goto 19
  !
  ! Slope prescribed at left end.
15 c3(1) = 1.
  c2(1) = 0.
  goto 18
  !
  ! Second derivative prescribed at left end.
16 c3(1) = 2.
  c2(1) = 1.
  c1(1) = 3.*c3(2) - c2(2)/2.*c1(1)
18 if (n.eq.2)  goto 25
  !
  ! If there are interior knots, generate the corresponding equations and
  ! carry out the forward pass of gauss elimination, after which the M-th
  ! equation reads    c3(M)*S(M) + c2(M)*S(M+1) = c1(M).
  !
19 continue
  do m=2,l
    g = -c2(m+1)/c3(m-1)
    c1(m) = g*c1(m-1) + 3.*(c2(m)*c3(m+1)+c2(m+1)*c3(m))
    c3(m) = g*c2(m-1) + 2.*(c2(m) + c2(m+1))
  enddo
  !
  ! Construct last equation from the second boundary condition, of the form
  !           (-G*c3(N-1))*S(N-1) + c3(N)*S(N) = c1(N)
  ! If slope is prescribed at right end, one can go directly to back
  ! substitution, since C array happens to be set up just right for it
  ! at this point.
  !
  if (ibcend-1)                     21,30,24
21 if (n .eq. 3 .and. ibcbeg .eq. 0) goto 22
  !
  ! not-a-knot and N.GE.3, and either N.GT.3 or also not-a-knot at
  ! left endpoint.
  !
  g = c2(l) + c2(n)
  c1(n) = ((c2(n)+2.*g)*c3(n)*c2(l) + c2(n)**2*(c0(l)-c0(n-2))/c2(l))/g
  g = -g/c3(l)
  c3(n) = c2(l)
  goto 29
  !
  ! Either (N=3 and not-a-knot also at left) or (N=2 and not not-a-knot
  ! at left endpoint).
  !
22 c1(n) = 2.*c3(n)
  c3(n) = 1.
  goto 28
  !
  ! Second derivative prescribed at right endpoint.
24 c1(n) = 3.*c3(n) + c2(n)/2.*c1(n)
  c3(n) = 2.
  goto 28
25 if (ibcend-1)                     26,30,24
26 if (ibcbeg .gt. 0)                goto 22
  !
  ! not-a-knot at right endpoint and at left endpoint and N=2.
  c1(n) = c3(n)
  goto 30
28 g = -1./c3(l)
  !
  ! Complete forward pass of GAUSS elimination.
29 c3(n) = g*c2(l) + c3(n)
  c1(n) = (g*c1(l) + c1(n))/c3(n)
  !
  ! Carry out back substitution
30 continue
  do j=l,1,-1
    c1(j) = (c1(j) - c2(j)*c1(j+1))/c3(j)
  enddo
  !
  ! Generate cubic coefficients in each interval, i.e., the derivatives
  ! at its left endpoint, from value and slope at its endpoints.
  !
  do i=2,n
    dtau = c2(i)
    divdf1 = (c0(i) - c0(i-1))/dtau
    divdf3 = c1(i-1) + c1(i) - 2.*divdf1
    c2(i-1) = 2.*(divdf1 - c1(i-1) - divdf3)/dtau
    c3(i-1) = (divdf3/dtau)*(6./dtau)
  enddo
  !
  ! Compute in addition c2(N). set c3(N) to 0.
  c2(n) = c2(l) + c3(l)*dtau
  c3(n) = 0.
end subroutine cubspl4
!
subroutine cubspl8(n,tau,c0,c1,c2,c3,ibcbeg,ibcend,error)
  use gbl_message
  use greg_interfaces, except_this=>cubspl8
  !---------------------------------------------------------------------
  ! @ public
  !  Piecewise cubic spline interpolants computation; adapted from
  !  'A practical guide to SPLINES' , CARL DE BOOR, Applied Mathematical
  !  Sciences, SPRINGER-VERLAG, VOL.27, P57-59 (1978).
  !
  !  c1(1), c1(N) are boundary condition information. Specifically:
  !
  !  IBCBEG = 0 means no boundary condition at tau(1) is given. In this
  !             case, the not-a-knot condition is used, i.e. the jump in
  !             the third derivative across TAU(2) is forced to zero,
  !             thus the first and the second cubic polynomial pieces
  !             are made to coincide.
  !  IBCBEG = 1 means that the slope at TAU(1) is made to equal c1(1),
  !             supplied by input.
  !  IBCBEG = 2 means that the second derivative at TAU(1) is made to
  !             equal c1(1), supplied by input.
  !
  !  IBCEND = 0, 1, or 2 has analogous meaning concerning the boundary
  !             condition at TAU(N), with the additional information
  !             taken from c1(N).
  !
  !  CJ(I), J=1,...,4; I=1,...,L (= N-1) are the polynomial coefficients
  !  of the cubic interpolating spline. Precisely, in the interval
  !  [ TAU(I), TAU(I+1) ]  the spline F is given by
  !         F(X) = c0(I)+H*(c1(I)+H*(c2(I)+H*c3(I)/3.)/2.)
  !  where H = X - TAU(I).
  !
  !  In other words, for I=1,...,N, c1(I) and c2(I) are respectively
  !  equal to the values of the first and second derivatives of the
  !  interpolating spline, and c3(I) is equal to the third derivative
  !  of the interpolating spline in the interval [ TAU(I), TAU(I+1) ].
  !  c3(N) is meaningless and is set to 0.
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: n       ! Number of data points (>1)
  real(kind=8),    intent(in)    :: tau(n)  ! Abscissae of data points, strictly monotonous
  real(kind=8),    intent(inout) :: c0(n)   ! Ordinates of data points (in) / First polynomial coefficient of spline (out)
  real(kind=8),    intent(inout) :: c1(n)   ! Boundary condition information (in) / Second polynomial coefficient of spline (out)
  real(kind=8),    intent(out)   :: c2(n)   ! Third polynomial coefficient of spline
  real(kind=8),    intent(out)   :: c3(n)   ! Fourth polynomial coefficient of spline
  integer(kind=4), intent(in)    :: ibcbeg  ! Boundary condition indicator
  integer(kind=4), intent(in)    :: ibcend  ! Boundary condition indicator
  logical,         intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CUBSPL8'
  real(kind=8) :: taum1,g,dtau,divdf1,divdf3
  integer(kind=4) :: i,j,l,m
  !
  ! A tridiagonal linear system for the unknown slopes S(I) of
  ! F at TAU(I), I=1,...,N, is generated and then solved by gauss
  ! elimination, with S(I) ending up in c1(I), all I.
  ! c2(.) and c3(.) are used initially for temporary storage.
  !
  if (n.lt.2) then
    call greg_message(seve%e,rname,'Less than two pivots')
    error = .true.
    return
  endif
  !
  ! Check if TAU strictly monotonous
  taum1=tau(2)
  if (tau(2).lt.tau(1)) then
    do i=3,n
      if (tau(i).ge.taum1) then
        call greg_message(seve%e,rname,'Variable is not strictly monotonous')
        error = .true.
        return
      endif
      taum1 = tau(i)
    enddo
  elseif (tau(2).gt.tau(1)) then
    do i=3,n
      if (tau(i).le.taum1) then
        call greg_message(seve%e,rname,'Variable is not strictly monotonous')
        error = .true.
        return
      endif
      taum1 = tau(i)
    enddo
  else
    call greg_message(seve%e,rname,'Variable is not strictly monotonous')
    error = .true.
    return
  endif
  !
  l = n-1
  !
  ! Compute first differences of TAU sequence and store in c2(.).
  ! Also, compute first divided difference of data and store in c3(.).
  !
  do  m=2,n
    c2(m) = tau(m) - tau(m-1)
    c3(m) = (c0(m) - c0(m-1))/c2(m)
  enddo
  !
  ! Construct first equation from the boundary condition, of the form
  !             c3(1)*S(1) + c2(1)*S(2) = c1(1)
  !
  if (ibcbeg-1)                     11,15,16
11 if (n .gt. 2)                     goto 12
  !
  ! No condition at left end and N = 2.
  c3(1) = 1.d0
  c2(1) = 1.d0
  c1(1) = 2.d0*c3(2)
  goto 25
  !
  ! Not-a-knot condition at left end and N .GT. 2.
12 c3(1) = c2(3)
  c2(1) = c2(2) + c2(3)
  c1(1) = ((c2(2)+2.d0*c2(1))*c3(2)*c2(3)+c2(2)**2*c3(3))/c2(1)
  goto 19
  !
  ! Slope prescribed at left end.
15 c3(1) = 1.d0
  c2(1) = 0.d0
  goto 18
  !
  ! Second derivative prescribed at left end.
16 c3(1) = 2.d0
  c2(1) = 1.d0
  c1(1) = 3.d0*c3(2) - c2(2)/2.d0*c1(1)
18 if (n.eq.2)  goto 25
  !
  ! If there are interior knots, generate the corresponding equations and
  ! carry out the forward pass of gauss elimination, after which the M-th
  ! equation reads    c3(M)*S(M) + c2(M)*S(M+1) = c1(M).
  !
19 continue
  do m=2,l
    g = -c2(m+1)/c3(m-1)
    c1(m) = g*c1(m-1) + 3.d0*(c2(m)*c3(m+1)+c2(m+1)*c3(m))
    c3(m) = g*c2(m-1) + 2.d0*(c2(m) + c2(m+1))
  enddo
  !
  ! Construct last equation from the second boundary condition, of the form
  !           (-G*c3(N-1))*S(N-1) + c3(N)*S(N) = c1(N)
  ! If slope is prescribed at right end, one can go directly to back
  ! substitution, since C array happens to be set up just right for it
  ! at this point.
  !
  if (ibcend-1)                     21,30,24
21 if (n .eq. 3 .and. ibcbeg .eq. 0) goto 22
  !
  ! not-a-knot and N.GE.3, and either N.GT.3 or also not-a-knot at
  ! left endpoint.
  !
  g = c2(l) + c2(n)
  c1(n) = ((c2(n)+2.d0*g)*c3(n)*c2(l) + c2(n)**2*(c0(l)-c0(n-2))/c2(l))/g
  g = -g/c3(l)
  c3(n) = c2(l)
  goto 29
  !
  ! Either (N=3 and not-a-knot also at left) or (N=2 and not not-a-knot
  ! at left endpoint).
  !
22 c1(n) = 2.d0*c3(n)
  c3(n) = 1.d0
  goto 28
  !
  ! Second derivative prescribed at right endpoint.
24 c1(n) = 3.d0*c3(n) + c2(n)/2.d0*c1(n)
  c3(n) = 2.d0
  goto 28
25 if (ibcend-1)                     26,30,24
26 if (ibcbeg .gt. 0)                goto 22
  !
  ! not-a-knot at right endpoint and at left endpoint and N=2.
  c1(n) = c3(n)
  goto 30
28 g = -1.d0/c3(l)
  !
  ! Complete forward pass of GAUSS elimination.
29 c3(n) = g*c2(l) + c3(n)
  c1(n) = (g*c1(l) + c1(n))/c3(n)
  !
  ! Carry out back substitution
30 continue
  do j=l,1,-1
    c1(j) = (c1(j) - c2(j)*c1(j+1))/c3(j)
  enddo
  !
  ! Generate cubic coefficients in each interval, i.e., the derivatives
  ! at its left endpoint, from value and slope at its endpoints.
  !
  do i=2,n
    dtau = c2(i)
    divdf1 = (c0(i) - c0(i-1))/dtau
    divdf3 = c1(i-1) + c1(i) - 2.d0*divdf1
    c2(i-1) = 2.d0*(divdf1 - c1(i-1) - divdf3)/dtau
    c3(i-1) = (divdf3/dtau)*(6.d0/dtau)
  enddo
  !
  ! Compute in addition c2(N). set c3(N) to 0.
  c2(n) = c2(l) + c3(l)*dtau
  c3(n) = 0.d0
end subroutine cubspl8
