Program e02bffe

!     E02BFF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: e02bef, e02bff, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: fp, sfac
      Integer                          :: deriv, ifail, ifail_e02bef, lds,     &
                                          liwrk, lwrk, m, ncap7, nest, nx, r,  &
                                          sd2, start, xord
      Character (1)                    :: cstart
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: c(:), lamda(:), s(:,:), wdata(:),    &
                                          wrk(:), x(:), xdata(:), ydata(:)
      Integer, Allocatable             :: iwrk(:), ixloc(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: abs, min
!     .. Executable Statements ..
      Write (nout,*) 'E02BFF Example Program Results'

!     Skip heading in data file
      Read (nin,*)

!     Input the number of data points for the spline,
!     followed by the data points (XDATA), the function values (YDATA)
!     and the weights (WDATA).

      Read (nin,*) m
      nest = m + 4
      lwrk = 4*m + 16*nest + 41
!     allocate memory for generating the spline
      Allocate (xdata(m),ydata(m),wdata(m),iwrk(nest),lamda(nest),wrk(lwrk),   &
        c(nest))

      Read (nin,*)(xdata(r),ydata(r),wdata(r),r=1,m)

      cstart = 'C'

!     Read in the requested smoothing factor.
      Read (nin,*) sfac

!     Determine the spline approximation.

      ifail_e02bef = 0
      Call e02bef(cstart,m,xdata,ydata,wdata,sfac,nest,ncap7,lamda,c,fp,wrk,   &
        lwrk,iwrk,ifail_e02bef)
      If (ifail_e02bef/=0) Then
        Write (nout,99997)                                                     &
          'Failed to generate spline using data set provided.'
        Write (nout,99996) 'E02BEF returned IFAIL = ', ifail_e02bef
        Go To 100
      End If
      Deallocate (iwrk)

!     Read in the number of sample points requested.
      Read (nin,*) nx

!     Allocate memory for sample point locations and
!      function and derivative approximations.
      lds = nx
      liwrk = 3 + 3*nx
      Allocate (x(nx),s(lds,4),ixloc(nx),iwrk(liwrk))

!     Read in sample points.
      Read (nin,*) x(1:nx)

      xord = 0
      start = 0
      deriv = 3
      ifail = 1
      Call e02bff(start,ncap7,lamda,c,deriv,xord,x,ixloc,nx,s,lds,iwrk,liwrk,  &
        ifail)
      If (ifail>1) Then
        Write (nout,99996) ' E02BFF detected a fatal error. IFAIL =  ', ifail
        Go To 100
      End If

!     Output the results.
      Write (nout,*)
      Write (nout,99999)

      sd2 = min(abs(deriv),3) + 1
      Do r = 1, nx
        If (ixloc(r)>=4 .And. ixloc(r)<=ncap7-3) Then
          Write (nout,99998) x(r), ixloc(r), s(r,1:sd2)
        Else
          Write (nout,99998) x(r), ixloc(r)
        End If
      End Do

100   Continue
99999 Format (                                                                 &
        '        x   ixloc         s(x)        ds/dx      d2s/dx2      d3s/dx3'&
        )
99998 Format (1X,F8.4,3X,I5,4(1X,Es12.4))
99997 Format (1X,A)
99996 Format (1X,A,1X,I5)
    End Program e02bffe