* E02CAF Example Program Text
* Mark 14 Revised. NAG Copyright 1989.
* .. Parameters ..
INTEGER NMAX, MTOT, NA, NWORK
PARAMETER (NMAX=20,MTOT=400,NA=100,NWORK=1500)
INTEGER NIN, NOUT
PARAMETER (NIN=5,NOUT=6)
* .. Local Scalars ..
DOUBLE PRECISION YMAX
INTEGER I, IFAIL, J, K, L, MI, MJ, N, R, T
* .. Local Arrays ..
DOUBLE PRECISION A(NA), F(MTOT), FF(MTOT), NUX(NMAX), W(MTOT),
+ WORK(NWORK), X(MTOT), XMAX(NMAX), XMIN(NMAX)
INTEGER M(20)
* .. External Subroutines ..
EXTERNAL E02CAF, E02CBF
* .. Executable Statements ..
WRITE (NOUT,*) 'E02CAF Example Program Results'
* Skip heading in data file
READ (NIN,*)
* Input the number of lines NUX = NUX(I) on which data is given,
* and the required degree of fit in the X and NUX directions
20 READ (NIN,*,END=120) N, K, L
WRITE (NOUT,*)
IF (N.GT.0 .AND. N.LE.NMAX) THEN
MJ = 0
* Input NUX(I), the number of data points on NUX = NUX(I) and the
* range of X-values on this line, for I = 1,2,...N
DO 40 I = 1, N
READ (NIN,*) NUX(I), MI, XMIN(I), XMAX(I)
M(I) = MI
MJ = MJ + MI
40 CONTINUE
* Terminate program if the arrays have not been declared
* large enough to contain the data
IF (MTOT.LT.MJ) THEN
WRITE (NOUT,99999)
+ 'MTOT is too small. It should be at least ', MJ
GO TO 120
END IF
* Input the X-values and function values, F, together with
* their weights, W.
READ (NIN,*) (X(I),F(I),W(I),I=1,MJ)
* Evaluate the coefficients, A, of the fit to this set of data
IFAIL = 1
*
CALL E02CAF(M,N,K,L,X,NUX,F,W,MTOT,A,NA,XMIN,XMAX,NUX,1,NUX,1,
+ WORK,NWORK,IFAIL)
*
IF (IFAIL.NE.0) THEN
WRITE (NOUT,99999) ' ** E02CAF returned with IFAIL = ',
+ IFAIL
GO TO 120
END IF
MI = 0
WRITE (NOUT,*)
+ ' Data NUX Data X Data F Fitted F Residual'
WRITE (NOUT,*)
DO 80 R = 1, N
T = MI + 1
MI = MI + M(R)
YMAX = NUX(N)
IF (N.EQ.1) YMAX = YMAX + 1.0D0
* Evaluate the fitted polynomial at each of the data points
* on the line NUX = NUX(R)
IFAIL = 1
*
CALL E02CBF(T,MI,K,L,X,XMIN(R),XMAX(R),NUX(R),NUX(1),YMAX,
+ FF,A,NA,WORK,NWORK,IFAIL)
*
IF (IFAIL.EQ.0) THEN
* Output the data and fitted values on the line NUX = NUX(R)
DO 60 I = T, MI
WRITE (NOUT,99998) NUX(R), X(I), F(I), FF(I),
+ FF(I) - F(I)
60 CONTINUE
WRITE (NOUT,*)
ELSE
WRITE (NOUT,99999) ' ** E02CBF returned with IFAIL = ',
+ IFAIL
GO TO 120
END IF
80 CONTINUE
* Output the Chebyshev coefficients of the fit
WRITE (NOUT,*) 'Chebyshev coefficients of the fit'
WRITE (NOUT,*)
DO 100 J = 1, K + 1
WRITE (NOUT,99997) (A(I),I=1+(J-1)*(L+1),J*(L+1))
100 CONTINUE
GO TO 20
END IF
120 CONTINUE
*
99999 FORMAT (1X,A,I5)
99998 FORMAT (3X,4F11.4,E11.2)
99997 FORMAT (1X,6F11.4)
END