Program g04eafe ! G04EAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02daf, g04eaf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: rss, tol Integer :: i, idf, ifail, ip, irank, j, ldq, & ldx, levels, lv, lwt, m, n, tdx Logical :: svd Character (1) :: mean, typ, weight ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: b(:), cov(:), h(:), p(:), q(:,:), & rep(:), res(:), se(:), v(:), wk(:), & wt(:), x(:,:), y(:) Integer, Allocatable :: ifact(:), isx(:) ! .. Executable Statements .. Write (nout,*) 'G04EAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in problem information Read (nin,*) n, levels, typ, weight, mean If (typ=='P' .Or. typ=='p') Then lv = levels Else lv = 1 End If If (typ=='C' .Or. typ=='c') Then tdx = levels Else tdx = levels - 1 End If If (weight=='w' .Or. weight=='W') Then lwt = n Else lwt = 1 End If ldx = n Allocate (x(ldx,tdx),ifact(n),v(lv),rep(levels),y(n),wt(lwt)) ! Read in data If (weight=='W' .Or. weight=='w') Then Read (nin,*)(ifact(i),y(i),wt(i),i=1,n) Else Read (nin,*)(ifact(i),y(i),i=1,n) End If If (typ=='P' .Or. typ=='p') Then Read (nin,*) v(1:levels) End If ! Calculate dummy variables ifail = 0 Call g04eaf(typ,n,levels,ifact,x,ldx,v,rep,ifail) If (typ=='C' .Or. typ=='c') Then m = levels Else m = levels - 1 End If ip = m If (mean=='M' .Or. mean=='m') Then ip = ip + 1 End If ldq = n Allocate (isx(m),b(ip),se(ip),cov(ip*(ip+1)/2),res(n),h(n),q(ldq,ip+1),p & (2*ip+ip*ip),wk(5*(ip-1)+ip*ip)) ! Use all the variables in the regression isx(1:m) = 1 ! Use the suggested value for tolerance tol = 0.00001E0_nag_wp ! Fit linear regression model ifail = 0 Call g02daf(mean,weight,n,x,ldx,m,isx,ip,y,wt,rss,idf,b,se,cov,res,h,q, & ldq,svd,irank,p,tol,wk,ifail) ! Display the results of the regression If (svd) Then Write (nout,99999) 'Model not of full rank, rank = ', irank Write (nout,*) End If Write (nout,99998) 'Residual sum of squares = ', rss Write (nout,99999) 'Degrees of freedom = ', idf Write (nout,*) Write (nout,*) 'Variable Parameter estimate Standard error' Write (nout,*) Write (nout,99997)(j,b(j),se(j),j=1,ip) 99999 Format (1X,A,I4) 99998 Format (1X,A,E12.4) 99997 Format (1X,I6,2E20.4) End Program g04eafe