! 07Jun1999 fgtok -impno -s r8_precision.sub r8_names.table "r8con.csh conversion"
c  cspline -- dmc 15 Feb 1999
c
c  a standard interface to various 1d spline setup routines
c
      subroutine r8cspline(x,nx,fspl,ibcxmin,bcxmin,ibcxmax,bcxmax,
     >   wk,iwk,ilinx,ier)
c
      IMPLICIT NONE
C============
C idecl:  explicitize implicit INTEGER declarations:
      INTEGER nx,iwk,ierx,inum,ix
C============
C idecl:  explicitize implicit REAL declarations:
      REAL*8 xo2,xo6
C============
      REAL*8 x(nx)                        ! x axis (in)
      REAL*8 fspl(4,nx)                   ! spline data (in/out)
      integer ibcxmin                   ! x(1) BC flag (in, see comments)
      REAL*8 bcxmin                       ! x(1) BC data (in, see comments)
      integer ibcxmax                   ! x(nx) BC flag (in, see comments)
      REAL*8 bcxmax                       ! x(nx) BC data (in, see comments)
      REAL*8 wk(iwk)                      ! workspace of size at least 5*nx
      integer ilinx                     ! even spacing flag (out)
      integer ier                       ! output, =0 means OK
c
c  ** note wk(...) array is not used unless ibcxmin=-1 (periodic spline
c  evaluation)
c
c  this routine computes spline coefficients for a 1d spline --
c  evaluation of the spline can be done by cspeval.for subroutines
c  or directly by inline code.
c
c  the input x axis x(1...nx) must be strictly ascending, i.e.
c  x(i+1).gt.x(i) is required for i=1 to nx-1.  This is checked and
c  ier=1 is set and the routine exits if the test is not satisfied.
c
c  on output, ilinx=1 is set if, to a reasonably close tolerance,
c  all grid spacings x(i+1)-x(i) are equal.  This allows a speedier
c  grid lookup algorithm on evaluation of the spline.  If on output
c  ilinx=2, this means the spline x axis is not evenly spaced.
c
c  the input data for the spline are given in f[j] = fspl(1,j).  The
c  output data are the spline coefficients fspl(2,j),fspl(3,j), and
c  fspl(4,j), j=1 to nx.  The result is a spline s(x) satisfying the
c  boundary conditions and with the properties
c
c     s(x(j)) = f(1,j)
c     s'(x) is continuous even at the grid points x(j)
c     s''(x) is continuous even at the grid points x(j)
c
c  the formula for evaluation of s(x) is:
c
c     let dx = x-x(i), where x(i).le.x.le.x(i+1).  Then,
c     s(x)=f(1,i) + dx*(f(2,i) +dx*(f(3,i) + dx*f(4,i)))
c
c  ==>boundary conditions.  Complete specification of a 1d spline
c  requires specification of boundary conditions at x(1) and x(nx).
c
c  this routine provides 4 options:
c
c  ibcxmin=-1  --  periodic boundary condition.  This means the
c    boundary conditions s'(x(1))=s'(x(nx)) and s''(x(1))=s''(x(nx))
c    are imposed.  Note that s(x(1))=s(x(nx)) (i.e. f(1,1)=f(1,nx))
c    is not required -- that is determined by the f array input data.
c    The periodic boundary condition is to be preferred for periodic
c    data.  When splining periodic data f(x) with period P, the relation
c    x(nx)=x(1)+n*P, n = the number of periods (usually 1), should hold.
c    (ibcxmax, bcxmin, bcxmax are ignored).
c
c  if a periodic boundary condition is set, this covers both boundaries.
c  for the other types of boundary conditions, the type of condition
c  chosen for the x(1) boundary need not be the same as the type chosen
c  for the x(nx) boundary.
c
c  ibcxmin=0 | ibcxmax=0 -- this specifies a "not a knot" boundary
c    condition -- see cubsplb.for.  This is a common way for inferring
c    a "good" spline boundary condition automatically from data in the
c    vicinity of the boundary.  (bcxmin | bcxmax are ignored).
c
c  ibcxmin=1 | ibcxmax=1 -- boundary condition is to have s'(x(1)) |
c    s'(x(nx)) match the passed value (bcxmin | bcxmax).
c
c  ibcxmin=2 | ibcxmax=2 -- boundary condition is to have s''(x(1)) |
c    s''(x(nx)) match the passed value (bcxmin | bcxmax).
c
c---------------------------------------------------------------------
c  error checks
c
      ier = 0
      if(nx.lt.4) then
         write(6,'('' ?cspline:  at least 4 x points required.'')')
         ier=1
      endif
      call ibc_ck(ibcxmin,'cspline','xmin',-1,2,ier)
      if(ibcxmin.ge.0) call ibc_ck(ibcxmax,'cspline','xmax',0,2,ier)
c
c  x axis check
c
      call r8splinck(x,nx,ilinx,1.0D-3,ierx)
      if(ierx.ne.0) ier=2
c
      if(ier.eq.2) then
         write(6,'('' ?cspline:  x axis not strict ascending'')')
      endif
c
      if(ibcxmin.eq.-1) then
         inum=5*nx
         if(iwk.lt.inum) then
            write(6,1009) inum,iwk,nx
 1009       format(
     >      ' ?cspline:  workspace too small.  need:  ',i6,' got:  ',i6/
     >      '  (need = 5*nx, nx=',i6)
            ier=3
         endif
      endif
c
      if(ier.ne.0) return
c
c  OK -- evaluate spline
c
      if(ibcxmin.eq.-1) then
         call r8cpspline(x,nx,fspl,wk) ! periodic spline
      else
         xo2=0.5D0
         xo6=1.0D0/6.0D0
c  use cubsplb, then fix coefficients as
         fspl(2,1)=bcxmin
         fspl(2,nx)=bcxmax
         call r8cubsplb(x,fspl,nx,ibcxmin,ibcxmax)
         do ix=1,nx
            fspl(3,ix)=fspl(3,ix)*xo2
            fspl(4,ix)=fspl(4,ix)*xo6
         enddo
      endif
C
      return
      end
c--------------------------
c  interface to pspline -- periodic spline
c
      subroutine r8cpspline(x,nx,fspl,wk)
c
      IMPLICIT NONE
C============
C idecl:  explicitize implicit INTEGER declarations:
      INTEGER nx,ix
C============
      REAL*8 x(nx),fspl(4,nx),wk(nx,5)
c
c  the coding is tricky, because the caller wants the spline coefficients
c  contigously packed, but pspline wants the data contiguously packed.
c
      do ix=1,nx
         wk(ix,1)=fspl(1,ix)
      enddo
c
      call r8pspline(nx,x,wk(1,1),wk(1,2),wk(1,3),wk(1,4),wk(1,5))
c
c  ok move stuff back into place
c
      do ix=1,nx
         fspl(2,ix)=wk(ix,2)
         fspl(3,ix)=wk(ix,3)
         fspl(4,ix)=wk(ix,4)
      enddo
c
      return
      end
