PROGRAM e02bafe

!      E02BAF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. 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