PROGRAM g10abfe ! G10ABF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g10abf, g10zaf, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: i, ifail, j, ldc, lwk, lwt, n, nord, & nrho CHARACTER (1) :: mode, weight ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: c(:,:), df(:), h(:), res(:), rho(:), & rss(:), wk(:), wt(:), wwt(:), x(:), & xord(:), y(:), yhat(:,:), yord(:) INTEGER, ALLOCATABLE :: iwrk(:) ! .. Executable Statements .. WRITE (nout,*) ' G10ABF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in problem size and control parameters READ (nin,*) n, weight, nrho IF (weight=='W' .OR. weight=='w') THEN lwt = n ELSE lwt = 0 END IF lwk = 9*n + 14 ldc = n - 1 ALLOCATE (x(n),y(n),wt(lwt),xord(n),yord(n),wwt(n),yhat(n,nrho), & c(ldc,3),res(n),h(n),wk(lwk),iwrk(n),rho(nrho),rss(nrho),df(nrho)) ! Read in the smoothing parameters READ (nin,*) rho(1:nrho) ! Read in data IF (lwt>0) THEN READ (nin,*) (x(i),y(i),wt(i),i=1,n) ELSE READ (nin,*) (x(i),y(i),i=1,n) END IF ! Reorder data into increasing X and remove tied observations, weighting ! accordingly ifail = 0 CALL g10zaf(weight,n,x,y,wt,nord,xord,yord,wwt,rss(1),iwrk,ifail) ! Fit cubic spline the first time ! NB: These are weighted as G10ZAF creates weights ifail = 0 mode = 'P' CALL g10abf(mode,'W',nord,xord,yord,wwt,rho(1),yhat(1,1),c,ldc,rss(1), & df(1),res,h,wk,ifail) ! Fit cubic spline the remaining NRHO - 1 times mode = 'Q' DO i = 2, nrho ifail = 0 CALL g10abf(mode,'W',nord,xord,yord,wwt,rho(i),yhat(1,i),c,ldc, & rss(i),df(i),res,h,wk,ifail) END DO ! Display results WRITE (nout,99999) 'Smoothing coefficient (rho) = ', rho(1:nrho) WRITE (nout,99998) 'Residual sum of squares = ', rss(1:nrho) WRITE (nout,99998) 'Degrees of freedom = ', df(1:nrho) WRITE (nout,*) WRITE (nout,*) ' X Y Fitted Values' DO i = 1, nord WRITE (nout,99997) xord(i), yord(i), (yhat(i,j),j=1,nrho) END DO 99999 FORMAT (1X,A,10(2X,F8.2)) 99998 FORMAT (1X,A,10(F10.3)) 99997 FORMAT (1X,2F8.4,14X,10(2X,F8.4)) END PROGRAM g10abfe