NAG Library Manual, Mark 30.3
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program e02cafe

!     E02CAF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: e02caf, e02cbf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: ymax
      Integer                          :: i, ifail, inuxp1, inuyp1, j, k, l,   &
                                          mi, mtot, n, na, nwork, r, t
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), f(:), ff(:), nux(:), nuy(:),   &
                                          w(:), work(:), x(:), xmax(:),        &
                                          xmin(:), y(:)
      Integer, Allocatable             :: m(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max, sum
!     .. Executable Statements ..
      Write (nout,*) 'E02CAF Example Program Results'

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

!     Input the number of lines Y = Y(I) on which data is given,
!     and the required degree of fit in the X and Y directions

      Read (nin,*) n, k, l
      inuxp1 = 1
      inuyp1 = 1
      na = (k+1)*(l+1)
      Allocate (a(na),m(n),y(n),xmin(n),xmax(n),nux(inuxp1),nuy(inuyp1))

!     Input Y(I), the number of data points on Y = Y(I) and the
!     range of X-values on this line, for I = 1,2,...N

      Do i = 1, n
        Read (nin,*) y(i), m(i), xmin(i), xmax(i)
      End Do

      mtot = sum(m(1:n))
      nwork = 3*mtot + 2*n*(k+2) + 5*(1+max(k,l))
      Allocate (x(mtot),f(mtot),w(mtot),ff(mtot),work(nwork))

!     Input the X-values and function values, F, together with
!     their weights, W.

      Read (nin,*)(x(i),f(i),w(i),i=1,mtot)

!     Evaluate the coefficients, A, of the fit to this set of data

      ifail = 0
      Call e02caf(m,n,k,l,x,y,f,w,mtot,a,na,xmin,xmax,nux,inuxp1,nuy,inuyp1,   &
        work,nwork,ifail)

      mi = 0

      Write (nout,*)
      Write (nout,*) '     Data Y     Data X     Data F   Fitted F   Residual'
      Write (nout,*)

      Do r = 1, n
        t = mi + 1
        mi = mi + m(r)
        ymax = y(n)

        If (n==1) Then
          ymax = ymax + 1.0E0_nag_wp
        End If

!       Evaluate the fitted polynomial at each of the data points
!       on the line Y = Y(R)

        ifail = 0
        Call e02cbf(t,mi,k,l,x,xmin(r),xmax(r),y(r),y(1),ymax,ff,a,na,work,    &
          nwork,ifail)

!       Output the data and fitted values on the line Y = Y(R)

        Do i = t, mi
          Write (nout,99999) y(r), x(i), f(i), ff(i), ff(i) - f(i)
        End Do

        Write (nout,*)
      End Do

!     Output the Chebyshev coefficients of the fit

      Write (nout,*) 'Chebyshev coefficients of the fit'
      Write (nout,*)

      Do j = 1, k + 1
        Write (nout,99998)(a(i),i=1+(j-1)*(l+1),j*(l+1))
      End Do

99999 Format (3X,4F11.4,E11.2)
99998 Format (1X,6F11.4)
    End Program e02cafe