Program e02bffe ! E02BFF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: e02bef, e02bff, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: fp, sfac Integer :: deriv, ifail, ifail_e02bef, lds, & liwrk, lwrk, m, ncap7, nest, nx, r, & sd2, start, xord Character (1) :: cstart ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:), lamda(:), s(:,:), wdata(:), & wrk(:), x(:), xdata(:), ydata(:) Integer, Allocatable :: iwrk(:), ixloc(:) ! .. Intrinsic Procedures .. Intrinsic :: abs, min ! .. Executable Statements .. Write (nout,*) 'E02BFF Example Program Results' ! Skip heading in data file Read (nin,*) ! Input the number of data points for the spline, ! followed by the data points (XDATA), the function values (YDATA) ! and the weights (WDATA). Read (nin,*) m nest = m + 4 lwrk = 4*m + 16*nest + 41 ! allocate memory for generating the spline Allocate (xdata(m),ydata(m),wdata(m),iwrk(nest),lamda(nest),wrk(lwrk), & c(nest)) Read (nin,*)(xdata(r),ydata(r),wdata(r),r=1,m) cstart = 'C' ! Read in the requested smoothing factor. Read (nin,*) sfac ! Determine the spline approximation. ifail_e02bef = 0 Call e02bef(cstart,m,xdata,ydata,wdata,sfac,nest,ncap7,lamda,c,fp,wrk, & lwrk,iwrk,ifail_e02bef) If (ifail_e02bef/=0) Then Write (nout,99997) & 'Failed to generate spline using data set provided.' Write (nout,99996) 'E02BEF returned IFAIL = ', ifail_e02bef Go To 100 End If Deallocate (iwrk) ! Read in the number of sample points requested. Read (nin,*) nx ! Allocate memory for sample point locations and ! function and derivative approximations. lds = nx liwrk = 3 + 3*nx Allocate (x(nx),s(lds,4),ixloc(nx),iwrk(liwrk)) ! Read in sample points. Read (nin,*) x(1:nx) xord = 0 start = 0 deriv = 3 ifail = 1 Call e02bff(start,ncap7,lamda,c,deriv,xord,x,ixloc,nx,s,lds,iwrk,liwrk, & ifail) If (ifail>1) Then Write (nout,99996) ' E02BFF detected a fatal error. IFAIL = ', ifail Go To 100 End If ! Output the results. Write (nout,*) Write (nout,99999) sd2 = min(abs(deriv),3) + 1 Do r = 1, nx If (ixloc(r)>=4 .And. ixloc(r)<=ncap7-3) Then Write (nout,99998) x(r), ixloc(r), s(r,1:sd2) Else Write (nout,99998) x(r), ixloc(r) End If End Do 100 Continue 99999 Format (' x ixloc s(x) ds/dx & & d2s/dx2 d3s/dx3 ') 99998 Format (1X,F8.4,3X,I5,4(1X,Es12.4)) 99997 Format (1X,A) 99996 Format (1X,A,1X,I5) End Program e02bffe