Program g02cgfe ! G02CGF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02cgf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Integer :: i, ifail, k, k1, ldc, ldcoef, ldr, & ldrinv, ldssp, ldwkz, n ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:,:), coef(:,:), r(:,:), & rinv(:,:), ssp(:,:), wkz(:,:), xbar(:) Real (Kind=nag_wp) :: con(3), reslt(13) ! .. Executable Statements .. Write (nout,*) 'G02CGF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in problem size Read (nin,*) n, k k1 = k + 1 ldr = k1 ldssp = k1 ldc = k ldcoef = k ldrinv = k ldwkz = k Allocate (c(ldc,k),coef(ldcoef,3),r(ldr,k1),rinv(ldrinv,k), & ssp(ldssp,k1),wkz(ldwkz,k),xbar(k1)) ! Read in data Read (nin,*) xbar(1:k1) Read (nin,*)(ssp(i,1:k1),i=1,k1) Read (nin,*)(r(i,1:k1),i=1,k1) ! Display data Write (nout,*) 'Means:' Write (nout,99999)(i,xbar(i),i=1,k1) Write (nout,*) Write (nout,*) 'Sums of squares and cross-products about means:' Write (nout,99998)(i,i=1,k1) Write (nout,99997)(i,ssp(i,1:k1),i=1,k1) Write (nout,*) Write (nout,*) 'Correlation coefficients:' Write (nout,99998)(i,i=1,k1) Write (nout,99997)(i,r(i,1:k1),i=1,k1) Write (nout,*) ! Fit multiple linear regression model ifail = 0 Call g02cgf(n,k1,k,xbar,ssp,ldssp,r,ldr,reslt,coef,ldcoef,con,rinv, & ldrinv,c,ldc,wkz,ldwkz,ifail) ! Display results Write (nout,*) 'Vble Coef Std err t-value' Write (nout,99996)(i,coef(i,1:3),i=1,k) Write (nout,*) Write (nout,99995) 'Const', con(1:3) Write (nout,*) Write (nout,*) 'Analysis of regression table :-' Write (nout,*) Write (nout,*) & ' Source Sum of squares D.F. Mean square F-value' Write (nout,*) Write (nout,99994) 'Due to regression', reslt(1:4) Write (nout,99994) 'About regression', reslt(5:7) Write (nout,99994) 'Total ', reslt(8:9) Write (nout,*) Write (nout,99993) 'Standard error of estimate =', reslt(10) Write (nout,99993) 'Multiple correlation (R) =', reslt(11) Write (nout,99993) 'Determination (R squared) =', reslt(12) Write (nout,99993) 'Corrected R squared =', reslt(13) Write (nout,*) Write (nout,*) 'Inverse of correlation matrix of independent variables:' Write (nout,99992)(i,i=1,k) Write (nout,99991)(i,rinv(i,1:k),i=1,k) Write (nout,*) Write (nout,*) 'Modified inverse matrix:' Write (nout,99992)(i,i=1,k) Write (nout,99991)(i,c(i,1:k),i=1,k) 99999 Format (1X,I4,F10.4) 99998 Format (1X,3I10) 99997 Format (1X,I4,3F10.4) 99996 Format (1X,I3,3F12.4) 99995 Format (1X,A,F11.4,2F13.4) 99994 Format (1X,A,F14.4,F8.0,2F14.4) 99993 Format (1X,A,F8.4) 99992 Format (1X,2I10) 99991 Format (1X,I4,2F10.4) End Program g02cgfe