Program g02effe ! G02EFF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02buf, g02eff, g02efh, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: fin, fout, rms, rsq, sw, tau Integer :: df, i, ifail, ldz, liuser, lruser, & m, m1, monlev, n Character (1) :: mean, weight ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: b(:), c(:), ruser(:), se(:), & wmean(:), z(:,:) Real (Kind=nag_wp) :: wt(1) Integer, Allocatable :: isx(:), iuser(:) ! .. Executable Statements .. Write (nout,*) 'G02EFF Example Program Results' Write (nout,*) Flush (nout) ! Skip heading in data file Read (nin,*) ! Read in the problem size and various control parameters Read (nin,*) n, m, fin, fout, tau, monlev ! Not using the user supplied arrays RUSER and IUSER liuser = 0 lruser = 0 m1 = m + 1 ldz = n Allocate (wmean(m1),c(m1*(m+2)/2),isx(m),b(m1),se(m1),iuser(liuser), & ruser(lruser),z(ldz,m1)) ! Read in augmented design matrix Z = (X | Y) Read (nin,*)(z(i,1:m1),i=1,n) ! Read in variable inclusion flags Read (nin,*) isx(1:m) ! No weights in this example weight = 'U' ! Compute upper-triangular sums of squares and cross-products of devations ! from the mean for the augmented matrix mean = 'M' ifail = 0 Call g02buf(mean,weight,n,m1,z,ldz,wt,sw,wmean,c,ifail) ! Perform stepwise selection of variables. ifail = 0 Call g02eff(m,n,wmean,c,sw,isx,fin,fout,tau,b,se,rsq,rms,df,monlev, & g02efh,iuser,ruser,ifail) ! Display results Write (nout,*) Write (nout,99999) 'Fitted Model Summary' Write (nout,99999) 'Term Estimate Standard Error' Write (nout,99998) 'Intercept:', b(1), se(1) Do i = 1, m If (isx(i)==1 .Or. isx(i)==2) Then Write (nout,99997) 'Variable:', i, b(i+1), se(i+1) End If End Do Write (nout,*) Write (nout,99996) 'RMS:', rms 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 Program g02effe