! 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
     1   , wk, iwk, ilinx, 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, ibcxmin, ibcxmax, iwk, ilinx, ier
      real(kind=dp) bcxmin, bcxmax
      real(kind=dp), dimension(nx) :: x
      real(kind=dp), dimension(4,nx) :: fspl
      real(kind=dp), dimension(iwk) :: wk
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: ierx, inum, ix
      real(kind=dp) :: xo2, xo6
C-----------------------------------------------
C============
C idecl:  explicitize implicit INTEGER declarations:
C============
C idecl:  explicitize implicit real(kind=dp) declarations:
C============
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 < 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 >= 0) call ibc_ck (ibcxmax, 'cspline', 'xmax', 0, 2, 
     1   ier)
c
c  x axis check
c
      call r8splinck (x, nx, ilinx, 0.001, ierx)
      if (ierx /= 0) ier = 2
      if (ier == 2) write (6, 
     1   '('' ?cspline:  x axis not strict ascending'')')
c
      if (ibcxmin == (-1)) then
         inum = 5*nx
         if (iwk < inum) then
            write (6, 1009) inum, iwk, nx
 1009       format(' ?cspline:  workspace too small.  need:  ',i6,
     1         ' got:  ',i6/'  (need = 5*nx, nx=',i6)
            ier = 3
         endif
      endif
c
      if (ier /= 0) return 
c
c  OK -- evaluate spline
c
      if (ibcxmin == (-1)) then
         call r8cpspline (x, nx, fspl, wk)       ! periodic spline
      else
         xo2 = 0.5E0_dp
         xo6 = 1.0E0_dp/6.0E0_dp
c  use cubsplb, then fix coefficients as
         fspl(2,1) = bcxmin
         fspl(2,nx) = bcxmax
         call r8cubsplb (x, fspl, nx, ibcxmin, ibcxmax)
         fspl(3,:nx) = fspl(3,:nx)*xo2
         fspl(4,:nx) = fspl(4,:nx)*xo6
      endif
C
      return 
      end subroutine r8cspline
c--------------------------
c  interface to pspline -- periodic spline
c
      subroutine r8cpspline(x, nx, fspl, wk)
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
      real(kind=dp), dimension(nx) :: x
      real(kind=dp), dimension(4,nx) :: fspl
      real(kind=dp), dimension(nx,5) :: wk
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: ix
C-----------------------------------------------
C============
C idecl:  explicitize implicit INTEGER declarations:
C============
c
c  the coding is tricky, because the caller wants the spline coefficients
c  contigously packed, but pspline wants the data contiguously packed.
c
      wk(:nx,1) = fspl(1,:nx)
c
      call r8pspline (nx, x, wk(1,1), wk(1,2), wk(1,3), wk(1,4), wk(1,5)
     1   )
c
c  ok move stuff back into place
c
      fspl(2,:nx) = wk(:nx,2)
      fspl(3,:nx) = wk(:nx,3)
      fspl(4,:nx) = wk(:nx,4)
c
      return 
      end subroutine r8cpspline
