* G02BTF Example Program Text * Mark 14 Release. NAG Copyright 1989. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER INCX, MMAX, MP PARAMETER (INCX=1,MMAX=18,MP=(MMAX*(MMAX+1))/2) DOUBLE PRECISION ONE PARAMETER (ONE=1.0D0) * .. Local Scalars .. DOUBLE PRECISION ALPHA, SW, WT INTEGER I, IFAIL, J, M, MM, N, NPRINT CHARACTER MEAN * .. Local Arrays .. DOUBLE PRECISION C(MP), V(MP), X(MMAX*INCX), XBAR(MMAX) * .. External Subroutines .. EXTERNAL F06FDF, G02BTF, X04CCF * .. Intrinsic Functions .. INTRINSIC MOD * .. Executable Statements .. WRITE (NOUT,*) 'G02BTF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*,END=40) MEAN, M, N, NPRINT SW = 0.0D0 IF (M.LT.MMAX) THEN DO 20 I = 1, N READ (NIN,*) WT, (X(J),J=1,M) IFAIL = 0 * * Calculate the sums of squares and cross-products matrix CALL G02BTF(MEAN,M,WT,X,INCX,SW,XBAR,C,IFAIL) * IF (MOD(I,NPRINT).EQ.0 .OR. I.EQ.N) THEN WRITE (NOUT,*) WRITE (NOUT,*) + '---------------------------------------------' WRITE (NOUT,99999) 'Observation: ', I, ' Weight = ', + WT WRITE (NOUT,*) + '---------------------------------------------' WRITE (NOUT,*) WRITE (NOUT,*) 'Means' WRITE (NOUT,99998) (XBAR(J),J=1,M) WRITE (NOUT,*) * Print the sums of squares and cross products matrix CALL X04CCF('Upper','Non-unit',M,C, + 'Sums of squares and cross-products',IFAIL) IF (SW.GT.ONE) THEN * Calculate the variance matrix ALPHA = ONE/(SW-ONE) MM = (M*(M+1))/2 CALL F06FDF(MM,ALPHA,C,1,V,1) * Print the variance matrix WRITE (NOUT,*) CALL X04CCF('Upper','Non-unit',M,V,'Variance matrix', + IFAIL) END IF END IF 20 CONTINUE ELSE WRITE (NOUT,99997) 'M is too large. M =', M END IF 40 STOP * 99999 FORMAT (1X,A,I4,A,F13.4) 99998 FORMAT (1X,4F14.4) 99997 FORMAT (1X,A,I5) END