NAG Library Manual, Mark 30.3
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program g02eefe

!     G02EEF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g02eef, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6, vnlen = 3
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: chrss, f, fin, rss
      Integer                          :: i, idf, ifail, ifr, istep, ldq, ldx, &
                                          lwt, m, maxip, n, nterm
      Logical                          :: addvar
      Character (1)                    :: mean, weight
      Character (3)                    :: newvar
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: exss(:), p(:), q(:,:), wk(:), wt(:), &
                                          x(:,:), y(:)
      Integer, Allocatable             :: isx(:)
      Character (vnlen), Allocatable   :: free(:), model(:), vname(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: count
!     .. Executable Statements ..
      Write (nout,*) 'G02EEF Example Program Results'
      Write (nout,*)

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

!     Read in the problem size and various control parameters
      Read (nin,*) n, m, mean, weight, fin

      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      ldx = n
      Allocate (x(ldx,m),y(n),wt(lwt),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 maximum number of parameters in the model
      maxip = count(isx(1:m)>0)
      If (mean=='M' .Or. mean=='m') Then
        maxip = maxip + 1
      End If

      ldq = n
      Allocate (model(maxip),free(maxip),exss(maxip),q(ldq,maxip+2),           &
        p(maxip+1),wk(2*maxip))

!     Loop over each variable, attempting to add each in turn
      istep = 0
      Do i = 1, m
!       Fit the linear regression model
        ifail = 0
        Call g02eef(istep,mean,weight,n,m,x,ldx,vname,isx,maxip,y,wt,fin,      &
          addvar,newvar,chrss,f,model,nterm,rss,idf,ifr,free,exss,q,ldq,p,wk,  &
          ifail)

!       Display the results at each step
        Write (nout,99999) 'Step ', istep
        If (.Not. addvar) Then
          Write (nout,99998) 'No further variables added maximum F =', f
          Write (nout,99993) 'Free variables:  ', free(1:ifr)
          Write (nout,*)                                                       &
            'Change in residual sums of squares for free variables:'
          Write (nout,99992) '                 ', exss(1:ifr)
          Go To 100
        Else
          Write (nout,99997) 'Added variable is ', newvar
          Write (nout,99996) 'Change in residual sum of squares =', chrss
          Write (nout,99998) 'F Statistic = ', f
          Write (nout,*)
          Write (nout,99995) 'Variables in model:', model(1:nterm)
          Write (nout,*)
          Write (nout,99994) 'Residual sum of squares = ', rss
          Write (nout,99999) 'Degrees of freedom = ', idf
          Write (nout,*)
          If (ifr==0) Then
            Write (nout,*) 'No free variables remaining'
            Go To 100
          End If
          Write (nout,99993) 'Free variables:  ', free(1:ifr)
          Write (nout,*)                                                       &
            'Change in residual sums of squares for free variables:'
          Write (nout,99992) '                 ', exss(1:ifr)
          Write (nout,*)
        End If
      End Do

100   Continue

99999 Format (1X,A,I2)
99998 Format (1X,A,F7.2)
99997 Format (1X,2A)
99996 Format (1X,A,E13.4)
99995 Format (1X,A,6(1X,A))
99994 Format (1X,A,E13.4)
99993 Format (1X,A,6(6X,A))
99992 Format (1X,A,6(F9.4))
    End Program g02eefe