Program g02eafe ! G02EAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02eaf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6, vnlen = 3 ! .. Local Scalars .. Integer :: i, ifail, k, ldmodl, ldx, lwt, m, n, & nmod Character (1) :: mean, weight ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: rss(:), wk(:), wt(:), x(:,:), y(:) Integer, Allocatable :: isx(:), mrank(:), nterms(:) Character (vnlen), Allocatable :: modl(:,:), vname(:) ! .. Intrinsic Procedures .. Intrinsic :: count, max ! .. Executable Statements .. Write (nout,*) 'G02EAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, m, mean, weight If (weight=='W' .Or. weight=='w') Then lwt = n Else lwt = 0 End If ldx = n Allocate (x(ldx,m),vname(m),isx(m),y(n),wt(lwt)) ! 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 number of free variables k = count(isx(1:m)==1) ldmodl = max(m,2**k) Allocate (modl(ldmodl,m),rss(ldmodl),nterms(ldmodl),mrank(ldmodl),wk(n*( & m+1))) ! Calculate residual sums of squares for all possible models ifail = 0 Call g02eaf(mean,weight,n,m,x,ldx,vname,isx,y,wt,nmod,modl,ldmodl,rss, & nterms,mrank,wk,ifail) ! Display results Write (nout,*) 'Number of RSS RANK MODL' Write (nout,*) 'parameters' Do i = 1, nmod Write (nout,99999) nterms(i), rss(i), mrank(i), modl(i,1:nterms(i)) End Do 99999 Format (1X,I8,F11.4,I4,3X,5(1X,A)) End Program g02eafe