subroutine cubspl (n,tau,c1,c2,c3,c4,ibcbeg,ibcend,error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! CLIC Internal routine
  !
  !	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).
  !
  ! Arguments :
  !     	N	I	Number of data points. assumed to be .ge. 2.	Input
  !	TAU	R*4(N)	Abscissae of data points, strictly monotonous	Input
  !	C1	R*4(N)	Ordinates of data points			Input
  !     	IBCBEG	I							Input
  !	IBCEND  I	Boundary condition indicators, and		Input
  !	C1	R*4(N)	First polynomial coefficient of spline	Output
  !	C2	R*4(N)	Second   --         --           --	Output/Input
  !	C3	R*4(N)	Third    --         --           --	Output
  !	C4	R*4(N)	Fourth   --         --           --	Output
  !
  ! 	C2(1), C2(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
  !		C2(1), supplied by input.
  !        IBCBEG = 2 means that the second derivative at TAU(1) is
  !		made to equal C2(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 C2(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) = C1(I)+H*(C2(I)+H*(C3(I)+H*C4(I)/3.)/2.)
  !	where H = X - TAU(I).
  !
  !	In other words, for I=1,...,N, C2(I) and C3(I) are respectively
  !	equal to the values of the first and second derivatives of
  !	the interpolating spline, and C4(I) is equal to the third
  !	derivative of the interpolating spline in the interval
  !	[ TAU(I), TAU(I+1) ]. C4(N) is meaningless and is set to 0.
  !---------------------------------------------------------------------
  integer :: n                      !
  real :: tau(n)                    !
  real :: c1(n)                     !
  real :: c2(n)                     !
  real :: c3(n)                     !
  real :: c4(n)                     !
  integer :: ibcbeg                 !
  integer :: ibcend                 !
  logical :: error                  !
  ! Local
  real :: taum1,g,dtau,divdf1,divdf3
  integer :: 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 C2(I), all I.
  ! C3(.) and C4(.) are used initially for temporary storage.
  !
  ! Check if N.GE.2
  !
  if (n.lt.2) stop 'F-CUBSPL4,  Less than two pivots'
  !
  ! Check if TAU strictly monotonous
  taum1=tau(2)
  if (tau(2)-tau(1)) 101,102,103
101 if (n.eq.2) goto 200
  do 1 i=3,n
    if ((tau(i)-taum1).ge.0.) goto 102
1 taum1=tau(i)
  goto 200
102 call gagout ('E-CUBSPL4,  Variable is not strictly monotonous')
  error = .true.
  return
103 if (n.eq.2) goto 200
  do 3 i=3,n
    if ((tau(i)-taum1).le.0.) goto 102
3 taum1=tau(i)
  !
200 l = n-1
  !
  ! Compute first differences of TAU sequence and store in C3(.).
  ! Also, compute first divided difference of data and store in C4(.).
  !
  do 10 m=2,n
    c3(m) = tau(m) - tau(m-1)
10 c4(m) = (c1(m) - c1(m-1))/c3(m)
  !
  ! Construct first equation from the boundary condition, of the form
  !             C4(1)*S(1) + C3(1)*S(2) = C2(1)
  !
  if (ibcbeg-1)                     11,15,16
11 if (n .gt. 2)                     goto 12
  !
  ! No condition at left end and N = 2.
  c4(1) = 1.
  c3(1) = 1.
  c2(1) = 2.*c4(2)
  goto 25
  !
  ! Not-a-knot condition at left end and N .GT. 2.
12 c4(1) = c3(3)
  c3(1) = c3(2) + c3(3)
  c2(1) = ((c3(2)+2.*c3(1))*c4(2)*c3(3)+c3(2)**2*c4(3))/c3(1)
  goto 19
  !
  ! Slope prescribed at left end.
15 c4(1) = 1.
  c3(1) = 0.
  goto 18
  !
  ! Second derivative prescribed at left end.
16 c4(1) = 2.
  c3(1) = 1.
  c2(1) = 3.*c4(2) - c3(2)/2.*c2(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    C4(M)*S(M) + C3(M)*S(M+1) = C2(M).
  !
19 do 20 m=2,l
    g = -c3(m+1)/c4(m-1)
    c2(m) = g*c2(m-1) + 3.*(c3(m)*c4(m+1)+c3(m+1)*c4(m))
20 c4(m) = g*c3(m-1) + 2.*(c3(m) + c3(m+1))
  !
  ! Construct last equation from the second boundary condition, of the form
  !           (-G*C4(N-1))*S(N-1) + C4(N)*S(N) = C2(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 = c3(l) + c3(n)
  c2(n) = ((c3(n)+2.*g)*c4(n)*c3(l)   &
    + c3(n)**2*(c1(l)-c1(n-2))/c3(l))/g
  g = -g/c4(l)
  c4(n) = c3(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 c2(n) = 2.*c4(n)
  c4(n) = 1.
  goto 28
  !
  ! Second derivative prescribed at right endpoint.
24 c2(n) = 3.*c4(n) + c3(n)/2.*c2(n)
  c4(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.
  c2(n) = c4(n)
  goto 30
28 g = -1./c4(l)
  !
  ! Complete forward pass of GAUSS elimination.
29 c4(n) = g*c3(l) + c4(n)
  c2(n) = (g*c2(l) + c2(n))/c4(n)
  !
  ! Carry out back substitution
30 do 40 j=l,1,-1
40 c2(j) = (c2(j) - c3(j)*c2(j+1))/c4(j)
  !
  ! Generate cubic coefficients in each interval, i.e., the derivatives
  ! at its left endpoint, from value and slope at its endpoints.
  !
  do 50 i=2,n
    dtau = c3(i)
    divdf1 = (c1(i) - c1(i-1))/dtau
    divdf3 = c2(i-1) + c2(i) - 2.*divdf1
    c3(i-1) = 2.*(divdf1 - c2(i-1) - divdf3)/dtau
50 c4(i-1) = (divdf3/dtau)*(6./dtau)
  !
  ! Compute in addition C3(N). set C4(N) to 0.
  c3(n) = c3(l) + c4(l)*dtau
  c4(n) = 0.
end subroutine cubspl
!
subroutine cubint (n,x,y,cm,ci)
  !---------------------------------------------------------------------
  ! Calculates the array of integrals required in SPLIF and SPLIFK
  !
  !     N      Number of data points (N is assumed .GE. 2).
  !     (X(I), Y(I), I=1,...,N) abcissae and ordinates of the points
  !            (X is assumed to be strictly increasing or decreasing).
  !     CM(I)  array of values of the second derivative of the spline-
  !            function at abscissae (X(I), I=1,...,N).
  !     CI(I)  array of the integrals of the cubic spline interpolation
  !            function from X(1) TO X(I).
  !---------------------------------------------------------------------
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: ci(n)                     !
  ! Local
  integer :: i
  real :: e
  !
  ci(1)=0.d0
  do  9 i=2,n
    e=x(i)-x(i-1)
    ci(i) = ci(i-1) +   &
      ( -e**2*(cm(i)+cm(i-1))/12.d0 + (y(i)+y(i-1)) ) *e/2.d0
9 continue
  return
end subroutine cubint
!
subroutine cuberr (n,x,y,ycub,err,iw,nw)
  !---------------------------------------------------------------------
  !       Crude estimate of spline-interpolation errors
  !       N       :number of pivots
  !       X       :array of pivots
  !       Y       :array of values of the function
  !       YCUB    :array of spline second-derivatives
  !       ERR     :output array for error estimates
  !       ( ERR(K): error in the interval [X(K-1)...X(K)] for K=3...N-1,
  !         ERR(1), ERR(2) and ERR(N) are set to 0.)
  !       IW      :printing device. set iw=0 to cancel the print.
  !                the estimated interpolation errors are listed for
  !                the worst intervals.
  !       NW      :approximate number of errors printed.
  !---------------------------------------------------------------------
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: ycub(n)                   !
  real :: err(n)                    !
  integer :: iw                     !
  integer :: nw                     !
  ! Global
  real :: splf
  ! Local
  real :: xkm1,xk,fmi,em1,ep1,barre,sup,f,xmi
  integer :: k,i,nbar
  !
  ! Formula definition
  f(k)=splf(n,x,y,ycub,xmi,k)
  !
  err(1)=0.d0
  err(2)=0.d0
  if (n.lt.3) return
  err(n)=0.d0
  if (n.eq.3) return
  xkm1=x(2)
  do 20 k=3,n-1
    xk=x(k)
    xmi=(xkm1+xk)/2.d0
    fmi=f(k)
    em1=abs(fmi-f(k-1))
    ep1=abs(fmi-f(k+1))
    if (k.eq.3.or.k.eq.(n-1)) goto 11
    goto 12
11  err(k)=max(em1,ep1)
    goto 20
12  err(k)=min(em1,ep1)
    xkm1=xk
20 continue
  !
  if (iw.le.0) return
  !
  barre=0.d0
  if (nw.gt.n-4) goto 59
  sup=0.d0
  do 30 i=3,n-1
    sup=max(sup,err(i))
30 continue
  barre=sup
  if (nw.le.1) goto 59
  do 50 nbar=1,nw-1
    sup=0.d0
    do 40 i=3,n-1
      if (err(i).lt.barre) sup=max(sup,err(i))
40  continue
    barre=sup
    if (barre.eq.0.d0) goto 59
50 continue
  !
59 do 60 i=2,n
    if (err(i).lt.barre) goto 60
    write(iw,101) x(i-1),x(i),err(i)
101 format(' [',e15.6,' ,',e15.6,' ]',e18.6)
60 continue
  return
end subroutine cuberr
!
function kspl (n,x,t,k)
  !---------------------------------------------------------------------
  !     The integer function KSPL returns the index KSPL such that the
  !     argument T lies within the interval [X(KSPL-1)...X(KSPL].
  !     In case of extrapolation, KSPL is forced to the value 2 or N.
  !
  !     N      number of data points (N is assumed .GE. 2).
  !     (X(I), I=1,...,N) abcissae of the points
  !            (X is assumed to be strictly increasing or decreasing).
  !     T      Argument for which the spline function is to be determined.
  !     K      Initial guess for KSPL.
  !---------------------------------------------------------------------
  integer :: kspl                   !
  integer :: n                      !
  real :: x(n)                      !
  real :: t                         !
  integer :: k                      !
  !
  kspl = k
  if (kspl.lt.2) kspl=2
  if (kspl.gt.n) kspl=n
  if (x(2).lt.x(1)) go to 100
  ! Case increasing
  if (t.le.x(kspl)) go to 11
10 if (kspl.eq.n) goto 20
  kspl=kspl+1
  if (t.gt.x(kspl)) go to 10
  go to 20
11 if (kspl.eq.2) goto 20
  if (t.ge.x(kspl-1)) go to 20
  kspl=kspl-1
  go to 11
  ! Case decreasing
100 if (t.ge.x(kspl)) go to 111
110 if (kspl.eq.n) goto 20
  kspl=kspl+1
  if (t.lt.x(kspl)) go to 110
  go to 20
111 if (kspl.eq.2) goto 20
  if (t.le.x(kspl-1)) go to 20
  kspl=kspl-1
  go to 111
20 return
end function kspl
!
function splf (n,x,y,cm,t,k)
  !---------------------------------------------------------------------
  !     *** Calculation of a cubic spline interpolation function. ***
  !     SPLF computes the value of a cubic polynomial piece within an
  !     interval given the abscissae, ordinates and second derivatives
  !     of the piece at both ends.
  !
  !     N      number of data points (N is assumed .ge. 2).
  !     (X(I), Y(I), I=1,...,N) abcissae and ordinates of the points
  !            (X is assumed to be strictly increasing or decreasing).
  !     CM(I)  array of values of the second derivative of the spline-
  !            function at abscissae (X(I), I=1,...,N).
  !     T      argument for which the spline function is to be determined.
  !     K      the user-supplied index K selects the cubic piece
  !            associated with the interval [X(K-1), X(K)]. K is assumed
  !            to be .GE. 2 and .LE. N.  The spline interpolation is
  !            obtained when T lies in this interval.
  !---------------------------------------------------------------------
  real :: splf                      !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Local
  real :: f,g,e
  !
  f = x(k) - t
  g = t - x(k-1)
  e = f + g
  splf = (-g*f*(cm(k-1)*(f+e)+cm(k)*(g+e))+6.d0*(g*y(k)+f*y(k-1)))   &
    / (6.d0*e)
  return
end function splf
!
function splf1 (n,x,y,cm,t,k)
  !---------------------------------------------------------------------
  !     Calculation of the first derivative of a cubic spline function.
  !     Arguments are the same as for SPLF.
  !---------------------------------------------------------------------
  real :: splf1                     !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Local
  real :: f,g,e,e2,e6
  !
  f = x(k) - t
  g = t - x(k-1)
  e = f + g
  e2= e+e
  e6= e/6.d0
  splf1=-cm(k-1)*(f**2/e2-e6)+cm(k)*(g**2/e2-e6)+(y(k)-y(k-1))/e
  return
end function splf1
!
function splf2 (n,x,y,cm,t,k)
  !---------------------------------------------------------------------
  !     Calculation of the second derivative of a cubic spline function.
  !     Arguments are the same as for SPLF.
  !---------------------------------------------------------------------
  real :: splf2                     !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Local
  real :: e,f,g
  !
  f = x(k) - t
  g = t - x(k-1)
  e = f + g
  splf2 = (cm(k-1)*f + cm(k)*g) / e
  return
end function splf2
!
function splfi (n,x,y,cm,ci,t,k)
  !---------------------------------------------------------------------
  !     *** calculates the integral of a cubic spline interpolation
  !         function from X(1) to X(T).
  !
  !     *** N,X,Y,CM,T,K are the same as in SPLF.
  !     *** CI(I): array of integrals of the spline function from X(1)
  !                to X(I). The array CI can be computed with CUBINT.
  !---------------------------------------------------------------------
  real :: splfi                     !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: ci(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Local
  real :: e,f,g,f2,g2,e2
  !
  f=x(k)-t
  g=t-x(k-1)
  e=f+g
  f2=f**2
  g2=g**2
  e2=2.d0*e**2
  splfi = ci(k-1) + (y(k-1)-e2*cm(k-1)/24.d0)*e/2.d0 +   &
    ( -f2*(cm(k-1)*(f2-e2)+12.d0*y(k-1))   &
    +g2*(cm(k)*(g2-e2)+12.d0*y(k))   ) / (24.d0*e)
  return
end function splfi
!
function splfk (n,x,y,cm,t,k)
  !---------------------------------------------------------------------
  !     *** Calculation of a cubic spline interpolation function. ***
  !     SPLFK computes the value of a cubic polynomial piece within an
  !     interval given the abscissae, ordinates and second derivatives
  !     of the piece at both ends.
  !
  !     *** The arguments are the same as those of SPLF, excepted for K.
  !     *** K:  computed as K=KSPL(N,X,T,K)
  !---------------------------------------------------------------------
  real :: splfk                     !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Global
  integer :: kspl
  real :: splf
  k     = kspl (n,x,t,k)
  splfk = splf (n,x,y,cm,t,k)
  return
end function splfk
!
function splf1k (n,x,y,cm,t,k)
  !---------------------------------------------------------------------
  !     Calculation of the first derivative of a cubic spline function.
  !     *** The arguments are the same as those of SPLF1, excepted for K.
  !     *** K:  computed as K=KSPL(N,X,T,K)
  !---------------------------------------------------------------------
  real :: splf1k                    !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Global
  integer :: kspl
  real :: splf1
  k      = kspl (n,x,t,k)
  splf1k = splf1 (n,x,y,cm,t,k)
  return
end function splf1k
!
function splf2k (n,x,y,cm,t,k)
  !---------------------------------------------------------------------
  !     Calculation of the second derivative of a cubic spline function.
  !     *** The arguments are the same as those of SPLF2, excepted for K.
  !     *** K:  computed as K=KSPL(N,X,T,K)
  !---------------------------------------------------------------------
  real :: splf2k                    !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Global
  integer :: kspl
  real :: splf2
  k      = kspl (n,x,t,k)
  splf2k = splf2 (n,x,y,cm,t,k)
  return
end function splf2k
!
function splfik (n,x,y,cm,ci,t,k)
  !---------------------------------------------------------------------
  !     Calculation of the integral of a cubic spline function.
  !     *** The arguments are the same as those of SPLFI, excepted for K.
  !     *** K:  computed as K=KSPL(N,X,T,K)
  !---------------------------------------------------------------------
  real :: splfik                    !
  integer :: n                      !
  real :: x(n)                      !
  real :: y(n)                      !
  real :: cm(n)                     !
  real :: ci(n)                     !
  real :: t                         !
  integer :: k                      !
  ! Global
  integer :: kspl
  real :: splfi
  k      = kspl (n,x,t,k)
  splfik = splfi (n,x,y,cm,ci,t,k)
  return
end function splfik
