Program e02dafe ! E02DAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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 (px8) 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