PROGRAM e02befe ! E02BEF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : e02bbf, e02bef, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. REAL (KIND=nag_wp) :: fp, s, txr INTEGER :: ifail, ioerr, j, lwrk, m, n, nest, r CHARACTER (1) :: start ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: c(:), lamda(:), sp(:), w(:), wrk(:), & x(:), y(:) INTEGER, ALLOCATABLE :: iwrk(:) ! .. Executable Statements .. WRITE (nout,*) 'E02BEF Example Program Results' ! Skip heading in data file READ (nin,*) ! Input the number of data points, followed by the data points (X), ! the function values (Y) and the weights (W). READ (nin,*) m nest = m + 4 lwrk = 4*m + 16*nest + 41 ALLOCATE (x(m),y(m),w(m),iwrk(nest),lamda(nest),wrk(lwrk),c(nest), & sp(2*m-1)) DO r = 1, m READ (nin,*) x(r), y(r), w(r) END DO start = 'C' ! Read in successive values of S until end of data file. DATA: DO READ (nin,*,IOSTAT=ioerr) s IF (ioerr<0) THEN EXIT DATA END IF ! Determine the spline approximation. ifail = 0 CALL e02bef(start,m,x,y,w,s,nest,n,lamda,c,fp,wrk,lwrk,iwrk,ifail) ! Evaluate the spline at each X point and midway between ! X points, saving the results in SP. DO r = 1, m ifail = 0 CALL e02bbf(n,lamda,c,x(r),sp((r-1)*2+1),ifail) END DO DO r = 1, m - 1 txr = (x(r)+x(r+1))/2.0E0_nag_wp ifail = 0 CALL e02bbf(n,lamda,c,txr,sp(r*2),ifail) END DO ! Output the results. WRITE (nout,*) WRITE (nout,99999) 'Calling with smoothing factor S =', s WRITE (nout,*) WRITE (nout,*) ' B-Spline' WRITE (nout,*) & ' J Knot LAMDA(J+2) Coefficient C(J)' WRITE (nout,99998) 1, c(1) DO j = 2, n - 5 WRITE (nout,99997) j, lamda(j+2), c(j) END DO WRITE (nout,99998) n - 4, c(n-4) WRITE (nout,*) WRITE (nout,99999) 'Weighted sum of squared residuals FP =', fp IF (fp==0.0E0_nag_wp) THEN WRITE (nout,*) '(The spline is an interpolating spline)' ELSE IF (n==8) THEN WRITE (nout,*) & '(The spline is the weighted least-squares cubic polynomial)' END IF WRITE (nout,*) start = 'W' END DO DATA 99999 FORMAT (1X,A,1P,E12.3) 99998 FORMAT (11X,I4,20X,F16.4) 99997 FORMAT (11X,I4,2F18.4) END PROGRAM e02befe