Program g02eefe ! G02EEF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02eef, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6, vnlen = 3 ! .. Local Scalars .. Real (Kind=nag_wp) :: chrss, f, fin, rss Integer :: i, idf, ifail, ifr, istep, ldq, ldx, & lwt, m, maxip, n, nterm Logical :: addvar Character (1) :: mean, weight Character (3) :: newvar ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: exss(:), p(:), q(:,:), wk(:), wt(:), & x(:,:), y(:) Integer, Allocatable :: isx(:) Character (vnlen), Allocatable :: free(:), model(:), vname(:) ! .. Intrinsic Procedures .. Intrinsic :: count ! .. Executable Statements .. Write (nout,*) 'G02EEF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size and various control parameters Read (nin,*) n, m, mean, weight, fin If (weight=='W' .Or. weight=='w') Then lwt = n Else lwt = 0 End If ldx = n Allocate (x(ldx,m),y(n),wt(lwt),isx(m),vname(m)) ! Read in data If (lwt>0) Then Read (nin,*)(x(i,1:m),y(i),wt(i),i=1,n) Else Read (nin,*)(x(i,1:m),y(i),i=1,n) End If ! Read in variable inclusion flags Read (nin,*) isx(1:m) ! Read in first VNLEN characters of the variable names Read (nin,*) vname(1:m) ! Calculate the maximum number of parameters in the model maxip = count(isx(1:m)>0) If (mean=='M' .Or. mean=='m') Then maxip = maxip + 1 End If ldq = n Allocate (model(maxip),free(maxip),exss(maxip),q(ldq,maxip+2), & p(maxip+1),wk(2*maxip)) ! Loop over each variable, attempting to add each in turn istep = 0 Do i = 1, m ! Fit the linear regression model ifail = 0 Call g02eef(istep,mean,weight,n,m,x,ldx,vname,isx,maxip,y,wt,fin, & addvar,newvar,chrss,f,model,nterm,rss,idf,ifr,free,exss,q,ldq,p,wk, & ifail) ! Display the results at each step Write (nout,99999) 'Step ', istep If (.Not. addvar) Then Write (nout,99998) 'No further variables added maximum F =', f Write (nout,99993) 'Free variables: ', free(1:ifr) Write (nout,*) & 'Change in residual sums of squares for free variables:' Write (nout,99992) ' ', exss(1:ifr) Go To 100 Else Write (nout,99997) 'Added variable is ', newvar Write (nout,99996) 'Change in residual sum of squares =', chrss Write (nout,99998) 'F Statistic = ', f Write (nout,*) Write (nout,99995) 'Variables in model:', model(1:nterm) Write (nout,*) Write (nout,99994) 'Residual sum of squares = ', rss Write (nout,99999) 'Degrees of freedom = ', idf Write (nout,*) If (ifr==0) Then Write (nout,*) 'No free variables remaining' Go To 100 End If Write (nout,99993) 'Free variables: ', free(1:ifr) Write (nout,*) & 'Change in residual sums of squares for free variables:' Write (nout,99992) ' ', exss(1:ifr) Write (nout,*) End If End Do 100 Continue 99999 Format (1X,A,I2) 99998 Format (1X,A,F7.2) 99997 Format (1X,2A) 99996 Format (1X,A,E13.4) 99995 Format (1X,A,6(1X,A)) 99994 Format (1X,A,E13.4) 99993 Format (1X,A,6(6X,A)) 99992 Format (1X,A,6(F9.4)) End Program g02eefe