* G02EFF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, MMAX PARAMETER (NMAX=20,MMAX=10) * .. Local Scalars .. DOUBLE PRECISION FIN, FOUT, RMS, RSQ, SW, TAU INTEGER DF, I, IFAIL, J, M, MONLEV, N * .. Local Arrays .. DOUBLE PRECISION B(MMAX+1), C((MMAX+2)*(MMAX+1)/2), RUSER(1), + SE(MMAX+1), WMEAN(MMAX+1), WT(1), X(NMAX,MMAX+1) INTEGER ISX(MMAX), IUSER(1) * .. External Subroutines .. EXTERNAL G02BUF, G02EFF, MONFUN * .. Executable Statements .. WRITE (NOUT,*) 'G02EFF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*) N, M, FIN, FOUT, TAU, MONLEV IF (N.LE.NMAX .AND. M.LE.(MMAX)) THEN READ (NIN,*) ((X(I,J),J=1,M+1),I=1,N) READ (NIN,*) (ISX(J),J=1,M) * * Compute upper-triangular correlation matrix IFAIL = -1 CALL G02BUF('M','U',N,M+1,X,NMAX,WT,SW,WMEAN,C,IFAIL) * * Perform stepwise selection of variables IFAIL = -1 CALL G02EFF(M,N,WMEAN,C,SW,ISX,FIN,FOUT,TAU,B,SE,RSQ,RMS,DF, + MONLEV,MONFUN,IUSER,RUSER,IFAIL) * * Display summary information for fitted model WRITE (NOUT,*) WRITE (NOUT,99999) 'Fitted Model Summary' WRITE (NOUT,99999) + 'Term Estimate Standard Error' WRITE (NOUT,99998) 'Intercept:', B(1), SE(1) DO 20 I = 1, M IF (ISX(I).EQ.1 .OR. ISX(I).EQ.2) THEN WRITE (NOUT,99997) 'Variable:', I, B(I+1), SE(I+1) END IF 20 CONTINUE WRITE (NOUT,*) WRITE (NOUT,99996) 'RMS:', RMS END IF * STOP * 99999 FORMAT (1X,A) 99998 FORMAT (1X,A,4X,1P,E12.3,5X,E12.3) 99997 FORMAT (1X,A,1X,I3,1X,1P,E12.3,5X,E12.3) 99996 FORMAT (1X,A,1X,1P,E12.3) END * * Example monitor function for use by G02EFF * SUBROUTINE MONFUN(FLAG,VAR,VAL,IUSER,RUSER) * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) * .. Scalar Arguments .. DOUBLE PRECISION VAL INTEGER VAR CHARACTER FLAG * .. Array Arguments .. DOUBLE PRECISION RUSER(*) INTEGER IUSER(*) * .. Executable Statements .. CONTINUE IF (FLAG.EQ.'C') THEN WRITE (NOUT,99999) 'Variable', VAR, 'aliased' ELSE IF (FLAG.EQ.'S') THEN WRITE (NOUT,99998) 'Starting Stepwise Selection' ELSE IF (FLAG.EQ.'F') THEN WRITE (NOUT,99997) 'Forward Selection' ELSE IF (FLAG.EQ.'V') THEN WRITE (NOUT,99996) 'Variable', VAR, 'Variance ratio =', VAL ELSE IF (FLAG.EQ.'A') THEN WRITE (NOUT,99995) 'Adding variable', VAR, 'to model' ELSE IF (FLAG.EQ.'B') THEN WRITE (NOUT,99994) 'Backward Selection' ELSE IF (FLAG.EQ.'D') THEN WRITE (NOUT,99993) 'Dropping variable', VAR, 'from model' ELSE IF (FLAG.EQ.'K') THEN WRITE (NOUT,99992) 'Keeping all current variables' ELSE IF (FLAG.EQ.'X') THEN WRITE (NOUT,99991) 'Finished Stepwise Selection' END IF RETURN * 99999 FORMAT (1X,A,1X,I4,1X,A) 99998 FORMAT (/1X,A) 99997 FORMAT (/1X,A) 99996 FORMAT (1X,A,1X,I4,1X,A,1X,1P,E12.3) 99995 FORMAT (/1X,A,1X,I4,1X,A) 99994 FORMAT (/1X,A) 99993 FORMAT (/1X,A,1X,I4,1X,A) 99992 FORMAT (/1X,A) 99991 FORMAT (/1X,A) END