Program g02ecfe
! G02ECF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
! .. 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 Procedures ..
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