Program e02dafe

!     E02DAF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. 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_nag, 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_nag = 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_nag = sum_nag + (temp*w(iadres))**2
        End Do loop

      End Do

      Write (nout,*)
      Write (nout,99999) 'Sum of squared residuals', sum_nag
      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