PROGRAM g02kafe

!      G02KAF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g02kaf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: h, nep, rss, tau, tol
       INTEGER                         :: df, i, ifail, ip, ldx, m, n, niter,  &
                                          opt, optloo, orig
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: b(:), res(:), vif(:), x(:,:), y(:)
       REAL (KIND=nag_wp)              :: perr(5)
       INTEGER, ALLOCATABLE            :: isx(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          count
!      .. Executable Statements ..
       WRITE (nout,*) 'G02KAF Example Program Results'
       WRITE (nout,*)

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

!      Read in the problem size
       READ (nin,*) n, m, h, opt, tol, niter, orig, optloo, tau

       ldx = n
       ALLOCATE (x(ldx,m),y(n),isx(m))

!      Read in data
       READ (nin,*) (x(i,1:m),y(i),i=1,n)

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

!      Calculate IP
       ip = count(isx(1:m)==1)

       ALLOCATE (b(ip+1),vif(ip),res(n))

!      Fit ridge regression model
       ifail = -1
       CALL g02kaf(n,m,x,ldx,isx,ip,tau,y,h,opt,niter,tol,nep,orig,b,vif,res, &
          rss,df,optloo,perr,ifail)
       IF (ifail/=0) THEN
          IF (ifail/=-1) THEN
             GO TO 20
          END IF
       END IF

!      Display results
       WRITE (nout,99999) 'Value of ridge parameter:', h
       WRITE (nout,*)
       WRITE (nout,99998) 'Sum of squares of residuals:', rss
       WRITE (nout,99997) 'Degrees of freedom: ', df
       WRITE (nout,99999) 'Number of effective parameters:', nep
       WRITE (nout,*)
       WRITE (nout,*) 'Parameter estimates'
       WRITE (nout,99995) (i,b(i),i=1,ip+1)
       WRITE (nout,*)
       WRITE (nout,99996) 'Number of iterations:', niter
       WRITE (nout,*)
       IF (opt==1) THEN
          WRITE (nout,*) 'Ridge parameter minimises GCV'
       ELSE IF (opt==2) THEN
          WRITE (nout,*) 'Ridge parameter minimises UEV'
       ELSE IF (opt==3) THEN
          WRITE (nout,*) 'Ridge parameter minimises FPE'
       ELSE IF (opt==4) THEN
          WRITE (nout,*) 'Ridge parameter minimises BIC'
       END IF
       WRITE (nout,*)
       WRITE (nout,*) 'Estimated prediction errors:'
       WRITE (nout,99999) 'GCV    =', perr(1)
       WRITE (nout,99999) 'UEV    =', perr(2)
       WRITE (nout,99999) 'FPE    =', perr(3)
       WRITE (nout,99999) 'BIC    =', perr(4)
       IF (optloo==2) THEN
          WRITE (nout,99999) 'LOO CV =', perr(5)
       END IF
       WRITE (nout,*)
       WRITE (nout,*) 'Residuals'
       WRITE (nout,99995) (i,res(i),i=1,n)
       WRITE (nout,*)
       WRITE (nout,*) 'Variance inflation factors'
       WRITE (nout,99995) (i,vif(i),i=1,ip)

20     CONTINUE

99999  FORMAT (1X,A,1X,F10.4)
99998  FORMAT (1X,A,E11.4)
99997  FORMAT (1X,A,1X,I5)
99996  FORMAT (1X,A,I16)
99995  FORMAT (1X,I4,1X,F11.4)
    END PROGRAM g02kafe