PROGRAM nag_lin_reg_ex02

      ! Example Program Text for nag_lin_reg
      ! NAG fl90, Release 4. NAG Copyright 2000.

      ! .. Use Statements ..
      USE nag_examples_io, ONLY : nag_std_out, nag_std_in
      USE nag_lin_reg, ONLY : nag_mult_lin_reg
      USE nag_write_mat, ONLY : nag_write_tri_mat
      ! .. Implicit None Statement ..
      IMPLICIT NONE
      ! .. Intrinsic Functions ..
      INTRINSIC KIND
      ! .. Parameters ..
      INTEGER, PARAMETER :: wp = KIND(1.0D0)
      ! .. Local Scalars ..
      INTEGER :: i, j, m, n, p, rank
      REAL (wp) :: resid_sum_sq
      ! .. Local Arrays ..
      REAL (wp), ALLOCATABLE :: beta(:), cov(:), lev(:), resid(:), std_err(:), &
       x(:,:), y(:)
      LOGICAL, ALLOCATABLE :: var_in_model(:)
      ! .. Executable Statements ..
      WRITE (nag_std_out,*) 'Example Program Results for nag_lin_reg_ex02'

      READ (nag_std_in,*)          ! Skip heading in data file
      READ (nag_std_in,*) n, m

      ALLOCATE (x(n,m),y(n),beta(m+1),std_err(m+1),resid(n),lev(n), &
       var_in_model(m),cov(((m+1)*(m+2))/2)) ! Allocate storage

      DO i = 1, n
        READ (nag_std_in,*) x(i,:), y(i)
      END DO

      DO j = 1, 3
        SELECT CASE (j)
        CASE (1)
          WRITE (nag_std_out,'(/1x,a)') 'CASE 1: No constant term is included'

          CALL nag_mult_lin_reg(x,y,beta,add_alpha=.FALSE.,std_err=std_err, &
           rank=rank,cov=cov,resid=resid,resid_sum_sq=resid_sum_sq,lev=lev)
          ! number of the independent variables in the model p
          ! all x's are included and no constant term
          p = m
        CASE (2)
          WRITE (nag_std_out,'(/1x,a)') 'CASE 2: Including a constant term'

          CALL nag_mult_lin_reg(x,y,beta,std_err=std_err,rank=rank,cov=cov, &
           resid=resid,resid_sum_sq=resid_sum_sq,lev=lev)
          ! number of the independent variables in the model p
          ! all x's are included and a constant term
          p = m + 1
        CASE (3)
          var_in_model = .TRUE.
          var_in_model(2) = .FALSE.
          WRITE (nag_std_out,'(/1x,a)') &
           'CASE 3: Including a constant term and excluding variable no 2'

          CALL nag_mult_lin_reg(x,y,beta,std_err=std_err,rank=rank, &
           var_in_model=var_in_model,cov=cov,resid=resid, &
           resid_sum_sq=resid_sum_sq,lev=lev)
          ! number of the independent variables in the model p
          ! one x is excluded and a constant term
          p = m
        END SELECT
        IF (rank==p) THEN
          WRITE (nag_std_out,'(1x,a,i4)') 'The model is of full rank, rank=', &
           rank
        ELSE
          WRITE (nag_std_out,'(1x,a,i4)') &
           'The model is not of full rank, rank=', rank
        END IF
        WRITE (nag_std_out,'(1x,a,6i11)') 'x variables       ', (i,i=1,m+1)
        WRITE (nag_std_out,'(1x,a,6f11.6)') 'Estimates of beta ', beta
        WRITE (nag_std_out,'(1x,a,6f11.6)') 'Std_error for beta', std_err

        CALL nag_write_tri_mat('u',cov,format='f11.6',int_col_labels=.TRUE., &
         title='Estimate of covariance matrix',int_row_labels=.TRUE., &
         indent=16)

        WRITE (nag_std_out,*)
        WRITE (nag_std_out,*) ' Residuals       Leverages'
        DO i = 1, n
          WRITE (nag_std_out,'(1x,f10.4,6x,f10.4)') resid(i), lev(i)
        END DO
        WRITE (nag_std_out,'(1x,a,f8.4)') 'Residual sum of squares = ', &
         resid_sum_sq
      END DO

      DEALLOCATE (x,y,beta,std_err,resid,lev,var_in_model, &
       cov)                        ! Deallocate storage

    END PROGRAM nag_lin_reg_ex02