PROGRAM g02ecfe ! G02ECF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g02eaf, g02ecf, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6, vnlen = 3 ! .. Local Scalars .. REAL (KIND=nag_wp) :: sigsq, tss INTEGER :: i, ifail, k, ldmodl, ldx, lwt, m, n, & nmod CHARACTER (1) :: mean, weight ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: cp(:), rsq(:), rss(:), wk(:), wt(:), & x(:,:), y(:) INTEGER, ALLOCATABLE :: isx(:), mrank(:), nterms(:) CHARACTER (vnlen), ALLOCATABLE :: modl(:,:), vname(:) ! .. Intrinsic Functions .. INTRINSIC count, max, real ! .. Executable Statements .. WRITE (nout,*) 'G02ECF 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),wt(lwt),y(n),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 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 ifail = 0 CALL g02eaf(mean,weight,n,m,x,ldx,vname,isx,y,wt,nmod,modl,ldmodl,rss, & nterms,mrank,wk,ifail) ! Extract total sums of squares tss = rss(1) ! Calculate best estimate of true variance from full model sigsq = rss(nmod)/real(n-nterms(nmod)-1,kind=nag_wp) ALLOCATE (rsq(nmod),cp(nmod)) ! Calculate R-squared and Mallows Cp ifail = 0 CALL g02ecf('M',n,sigsq,tss,nmod,nterms,rss,rsq,cp,ifail) ! Display results WRITE (nout,*) 'Number of CP RSQ MODEL' WRITE (nout,*) 'parameters' WRITE (nout,*) DO i = 1, nmod WRITE (nout,99999) nterms(i), cp(i), rsq(i), modl(i,1:nterms(i)) END DO 99999 FORMAT (1X,I7,F11.2,F8.4,1X,5(1X,A)) END PROGRAM g02ecfe