PROGRAM e02dafe

!      E02DAF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : e02daf, e02def, e02zaf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
       CHARACTER (1), PARAMETER        :: label(2) = (/ 'X', 'Y'/)
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: eps, sigma, sum, temp
       INTEGER                         :: i, iadres, ifail, itemp, j, m,       &
                                          nadres, nc, npoint, nws, px, py, rank
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: c(:), dl(:), f(:), ff(:), lamda(:),  &
                                          mu(:), w(:), wrk(:), ws(:), x(:), y(:)
       INTEGER, ALLOCATABLE            :: adres(:), iwrk(:), point(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'E02DAF Example Program Results'

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

!      Read data, interchanging X and Y axes if PX < PY

       READ (nin,*) eps
       READ (nin,*) m
       READ (nin,*) px, py

       IF (px<py) THEN
          itemp = px
          px = py
          py = itemp
          itemp = 1
       ELSE
          itemp = 0
       END IF

       nadres = (px-7)*(py-7)
       npoint = m + (px-7)*(py-7)
       nc = (px-4)*(py-4)
       nws = (2*nc+1)*(3*py-6) - 2
       ALLOCATE (lamda(px),mu(py),x(m),y(m),f(m),ff(m),w(m),dl(nc),c(nc), &
          ws(nws),point(npoint),adres(nadres),wrk(py-4),iwrk(py-4))

       IF (itemp==1) THEN
          READ (nin,*) (y(i),x(i),f(i),w(i),i=1,m)

          IF (py>8) THEN
             READ (nin,*) mu(5:(py-4))
          END IF

          IF (px>8) THEN
             READ (nin,*) lamda(5:(px-4))
          END IF

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

          IF (px>8) THEN
             READ (nin,*) lamda(5:(px-4))
          END IF

          IF (py>8) THEN
             READ (nin,*) mu(5:(py-4))
          END IF

       END IF

!      Sort points into panel order

       ifail = 0
       CALL e02zaf(px,py,lamda,mu,m,x,y,point,npoint,adres,nadres,ifail)

       WRITE (nout,*)
       WRITE (nout,99995) 'Interior ', label(itemp+1), '-knots'

       IF (px==8) THEN
          WRITE (nout,*) 'None'
       ELSE

          DO j = 5, px - 4
             WRITE (nout,99996) lamda(j)
          END DO

       END IF

       WRITE (nout,*)
       WRITE (nout,99995) 'Interior ', label(2-itemp), '-knots'

       IF (py==8) THEN
          WRITE (nout,*) 'None'
       ELSE

          DO j = 5, py - 4
             WRITE (nout,99996) mu(j)
          END DO

       END IF

!      Fit bicubic spline to data points

       ifail = 0
       CALL e02daf(m,px,py,x,y,f,w,lamda,mu,point,npoint,dl,c,nc,ws,nws,eps, &
          sigma,rank,ifail)

       WRITE (nout,*)
       WRITE (nout,99999) 'Sum of squares of residual RHS', sigma
       WRITE (nout,*)
       WRITE (nout,99998) 'Rank', rank

!      Evaluate spline at the data points

       ifail = 0
       CALL e02def(m,px,py,x,y,lamda,mu,c,ff,wrk,iwrk,ifail)

       sum = 0.0E0_nag_wp

       IF (itemp==1) THEN
          WRITE (nout,*)
          WRITE (nout,*) 'X and Y have been interchanged'
       END IF

!      Output data points, fitted values and residuals

       WRITE (nout,*)
       WRITE (nout,*) &
          '      X          Y          Data       Fit     Residual'

       DO i = 1, nadres
          iadres = i + m

LOOP:     DO
             iadres = point(iadres)

             IF (iadres<=0) THEN
                EXIT LOOP
             END IF

             temp = ff(iadres) - f(iadres)
             WRITE (nout,99997) x(iadres), y(iadres), f(iadres), ff(iadres), &
                temp
             sum = sum + (temp*w(iadres))**2
          END DO LOOP

       END DO

       WRITE (nout,*)
       WRITE (nout,99999) 'Sum of squared residuals', sum
       WRITE (nout,*)
       WRITE (nout,*) 'Spline coefficients'

       DO i = 1, px - 4
          WRITE (nout,99996) (c((i-1)*(py-4)+j),j=1,py-4)
       END DO

99999  FORMAT (1X,A,1P,E16.2)
99998  FORMAT (1X,A,I5)
99997  FORMAT (1X,4F11.4,E11.2)
99996  FORMAT (1X,6F11.4)
99995  FORMAT (1X,A,A1,A)
    END PROGRAM e02dafe