Program e02bafe

!     E02BAF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: e02baf, e02bbf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: fit, ss, xarg
      Integer                          :: ifail, iwght, j, m, ncap, ncap7, r
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: c(:), lamda(:), w(:), work1(:),      &
                                          work2(:), x(:), y(:)
!     .. Executable Statements ..
      Write (nout,*) 'E02BAF Example Program Results'

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

      Read (nin,*) m
      Read (nin,*) ncap, iwght
      ncap7 = ncap + 7
      Allocate (x(m),y(m),w(m),lamda(ncap7),c(ncap7),work1(m),work2(4*ncap7))

      Read (nin,*) lamda(5:(ncap+3))

      Do r = 1, m

        If (iwght==1) Then
          Read (nin,*) x(r), y(r)
          w(r) = 1.0E0_nag_wp
        Else
          Read (nin,*) x(r), y(r), w(r)
        End If

      End Do

      ifail = 0
      Call e02baf(m,ncap7,x,y,w,lamda,work1,work2,c,ss,ifail)

      Write (nout,*)
      Write (nout,*) '  J       LAMDA(J+2)     B-spline coeff C(J)'
      Write (nout,*)

      j = 1
      Write (nout,99998) j, c(1)

      Do j = 2, ncap + 2
        Write (nout,99999) j, lamda(j+2), c(j)
      End Do

      Write (nout,99998) ncap + 3, c(ncap+3)
      Write (nout,*)
      Write (nout,99997) 'Residual sum of squares = ', ss
      Write (nout,*)
      Write (nout,*) 'Cubic spline approximation and residuals'
      Write (nout,*)
      Write (nout,*)                                                           &
        '  R   Abscissa     Weight   Ordinate     Spline  Residual'
      Write (nout,*)

      Do r = 1, m

        ifail = 0
        Call e02bbf(ncap7,lamda,c,x(r),fit,ifail)

        Write (nout,99995) r, x(r), w(r), y(r), fit, fit - y(r)

        If (r<m) Then
          xarg = 0.5E0_nag_wp*(x(r)+x(r+1))

          ifail = 0
          Call e02bbf(ncap7,lamda,c,xarg,fit,ifail)

          Write (nout,99996) xarg, fit
        End If

      End Do

99999 Format (1X,I3,F15.4,F20.4)
99998 Format (1X,I3,F35.4)
99997 Format (1X,A,E12.2)
99996 Format (1X,F14.4,F33.4)
99995 Format (1X,I3,4F11.4,E10.2)
    End Program e02bafe