Program g02effe

!     G02EFF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g02buf, g02eff, g02efh, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: fin, fout, rms, rsq, sw, tau
      Integer                          :: df, i, ifail, ldz, liuser, lruser,   &
                                          m, m1, monlev, n
      Character (1)                    :: mean, weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: b(:), c(:), ruser(:), se(:),         &
                                          wmean(:), z(:,:)
      Real (Kind=nag_wp)               :: wt(1)
      Integer, Allocatable             :: isx(:), iuser(:)
!     .. Executable Statements ..
      Write (nout,*) 'G02EFF Example Program Results'
      Write (nout,*)
      Flush (nout)

!     Skip heading in data file
      Read (nin,*)

!     Read in the problem size and various control parameters
      Read (nin,*) n, m, fin, fout, tau, monlev

!     Not using the user supplied arrays RUSER and IUSER
      liuser = 0
      lruser = 0

      m1 = m + 1
      ldz = n
      Allocate (wmean(m1),c(m1*(m+2)/2),isx(m),b(m1),se(m1),iuser(liuser),     &
        ruser(lruser),z(ldz,m1))

!     Read in augmented design matrix Z = (X | Y)
      Read (nin,*)(z(i,1:m1),i=1,n)

!     Read in variable inclusion flags
      Read (nin,*) isx(1:m)

!     No weights in this example
      weight = 'U'

!     Compute upper-triangular sums of squares and cross-products of deviations
!     from the mean for the augmented matrix
      mean = 'M'
      ifail = 0
      Call g02buf(mean,weight,n,m1,z,ldz,wt,sw,wmean,c,ifail)

!     Perform stepwise selection of variables.
      ifail = 0
      Call g02eff(m,n,wmean,c,sw,isx,fin,fout,tau,b,se,rsq,rms,df,monlev,      &
        g02efh,iuser,ruser,ifail)

!     Display results
      Write (nout,*)
      Write (nout,99999) 'Fitted Model Summary'
      Write (nout,99999) 'Term              Estimate   Standard Error'
      Write (nout,99998) 'Intercept:', b(1), se(1)
      Do i = 1, m
        If (isx(i)==1 .Or. isx(i)==2) Then
          Write (nout,99997) 'Variable:', i, b(i+1), se(i+1)
        End If
      End Do
      Write (nout,*)
      Write (nout,99996) 'RMS:', rms

99999 Format (1X,A)
99998 Format (1X,A,4X,1P,E12.3,5X,E12.3)
99997 Format (1X,A,1X,I3,1X,1P,E12.3,5X,E12.3)
99996 Format (1X,A,1X,1P,E12.3)
    End Program g02effe