PROGRAM e02agfe

!      E02AGF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : e02agf, e02akf, f16dnf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: fiti, xmax, xmin
       INTEGER                         :: i, ifail, ipmax, k, kplus1, la, lda, &
                                          liwrk, lwrk, lyf, m, mf, n, np1
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), s(:), w(:), wrk(:), x(:),    &
                                          xf(:), y(:), yf(:)
       INTEGER, ALLOCATABLE            :: ip(:), iwrk(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          max, sum
!      .. Executable Statements ..
       WRITE (nout,*) 'E02AGF Example Program Results'

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

       READ (nin,*) mf
       liwrk = 2*mf + 2
       ALLOCATE (ip(mf),xf(mf),iwrk(liwrk))

       READ (nin,*) ip(1:mf)

!      Get max(IP) for later use

       CALL f16dnf(mf,ip,1,i,ipmax)

       READ (nin,*) xf(1:mf)

       lyf = mf + sum(ip(1:mf))
       ALLOCATE (yf(lyf))

       READ (nin,*) yf(1:lyf)

       READ (nin,*) m
       ALLOCATE (x(m),y(m),w(m))

       READ (nin,*) (x(i),y(i),w(i),i=1,m)

       READ (nin,*) k, xmin, xmax
       kplus1 = k + 1
       n = lyf
       np1 = n + 1
       lwrk = max(4*m+3*kplus1,8*n+5*ipmax+mf+10) + 2*n + 2
       lda = kplus1
       ALLOCATE (wrk(lwrk),a(lda,kplus1),s(kplus1))

       ifail = 0
       CALL e02agf(m,kplus1,lda,xmin,xmax,x,y,w,mf,xf,yf,lyf,ip,a,s,np1,wrk, &
          lwrk,iwrk,liwrk,ifail)

       WRITE (nout,*)
       WRITE (nout,*) 'Degree  RMS residual'
       WRITE (nout,99999) (i,s(i+1),i=np1-1,k)
       WRITE (nout,*)
       WRITE (nout,99996) 'Details of the fit of degree ', k
       WRITE (nout,*)
       WRITE (nout,*) '  Index   Coefficient'

       DO i = 1, kplus1
          WRITE (nout,99997) i - 1, a(kplus1,i)
       END DO

       WRITE (nout,*)
       WRITE (nout,*) '     I      X(I)       Y(I)       Fit     Residual'

       DO i = 1, m
          la = lda*kplus1 - k

          ifail = 0
          CALL e02akf(kplus1,xmin,xmax,a(kplus1,1),lda,la,x(i),fiti,ifail)

          WRITE (nout,99998) i, x(i), y(i), fiti, fiti - y(i)
       END DO

99999  FORMAT (1X,I4,1P,E15.2)
99998  FORMAT (1X,I6,3F11.4,E11.2)
99997  FORMAT (1X,I6,F11.4)
99996  FORMAT (1X,A,I2)
    END PROGRAM e02agfe