*     G02KBF Example Program Text
*     Mark 22 Release. NAG Copyright 2008.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          LDX, LDB, HMAX, LDPE
      PARAMETER        (LDX=50,LDB=10,HMAX=20,LDPE=5)
      INTEGER          LDVF
      PARAMETER        (LDVF=LDB-1)
*     .. Local Scalars ..
      INTEGER          I, IFAIL, IP, IP1, J, LH, LPEC, M, N, PL, WANTB,
     +                 WANTVF
*     .. Local Arrays ..
      DOUBLE PRECISION B(LDB,HMAX), H(HMAX), NEP(HMAX), PE(LDPE,HMAX),
     +                 VF(LDVF,HMAX), X(LDX,LDB), Y(LDX)
      INTEGER          ISX(HMAX)
      CHARACTER        PEC(LDPE)
*     .. External Subroutines ..
      EXTERNAL         G02KBF
*     .. Intrinsic Functions ..
      INTRINSIC        MIN
*     .. Executable Statements ..
      CONTINUE
*
      WRITE (NOUT,*) 'G02KBF Example Program Results'
*
*     Skip heading in data file
      READ (NIN,*)
*
*     Read in the problem size information
      READ (NIN,*) N, M, LH, LPEC, WANTB
*
*     Check array sizes
      IF (M.GT.LDB .OR. N.GT.LDX .OR. LH.GT.HMAX .OR. LPEC.GT.LDPE) THEN
         WRITE (NOUT,99990)
         GO TO 160
      END IF
*
*     Read in the data
      IF (LPEC.GT.0) THEN
         READ (NIN,*) (PEC(I),I=1,LPEC)
      END IF
      DO 20 I = 1, N
         READ (NIN,*) (X(I,J),J=1,M), Y(I)
   20 CONTINUE
*
*     Read in the ISX flags
      READ (NIN,*) (ISX(I),I=1,M)
*
*     Read in the ridge coefficients
      READ (NIN,*) (H(I),I=1,LH)
*
*     Total number of variables
      IP = 0
      DO 40 J = 1, M
         IF (ISX(J).EQ.1) THEN
            IP = IP + 1
         END IF
   40 CONTINUE
*
*     Output the variance inflation factors and parameter estimates
*     (original scalings)
      WANTVF = 1
*
*     Run the analysis
      IFAIL = 1
      CALL G02KBF(N,M,X,LDX,ISX,IP,Y,LH,H,NEP,WANTB,B,LDB,WANTVF,VF,
     +            LDVF,LPEC,PEC,PE,LDPE,IFAIL)
      IF (IFAIL.NE.0) THEN
         WRITE (NOUT,99991) IFAIL
         GO TO 160
      END IF
*     Output results
      IP1 = IP - 1
*
*     Summaries
      WRITE (NOUT,99994) 'Number of parameters used = ', IP + 1
      WRITE (NOUT,*) 'Effective number of parameters (NEP):'
      WRITE (NOUT,*) '   Ridge   '
      WRITE (NOUT,*) '   Coeff.  ', 'NEP'
      DO 60 I = 1, LH
         WRITE (NOUT,99993) H(I), NEP(I)
   60 CONTINUE
*
*     Parameter estimates
      IF (WANTB.NE.0) THEN
         WRITE (NOUT,*)
         IF (WANTB.EQ.1) THEN
            WRITE (NOUT,*) 'Parameter Estimates (Original scalings)'
         ELSE
            WRITE (NOUT,*) 'Parameter Estimates (Standarised)'
         END IF
         PL = MIN(IP,4)
         WRITE (NOUT,*) '  Ridge  '
         WRITE (NOUT,99997) '   Coeff.  ', ' Intercept ', (I,I=1,PL)
         IF (PL.LT.IP1) THEN
            WRITE (NOUT,99996) (I,I=PL+1,IP1)
         END IF
         PL = MIN(IP+1,5)
         DO 80 I = 1, LH
            WRITE (NOUT,99999) H(I), (B(J,I),J=1,PL)
            IF (PL.LT.IP) THEN
               WRITE (NOUT,99998) (B(J,I),J=PL+1,IP)
            END IF
   80    CONTINUE
      END IF
*
*     Variance inflation factors
      IF (WANTVF.NE.0) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Variance Inflation Factors'
         PL = MIN(IP,5)
         WRITE (NOUT,*) '  Ridge  '
         WRITE (NOUT,99995) '  Coeff.  ', (I,I=1,PL)
         IF (PL.LT.IP) THEN
            WRITE (NOUT,99996) (I,I=PL+1,IP)
         END IF
         DO 100 I = 1, LH
            WRITE (NOUT,99999) H(I), (VF(J,I),J=1,PL)
            IF (PL.LT.IP) THEN
               WRITE (NOUT,99998) (VF(J,I),J=PL+1,IP)
            END IF
  100    CONTINUE
      END IF
*
*     Prediction error criterion
      IF (LPEC.GT.0) THEN
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Prediction error criterion'
         PL = MIN(LPEC,5)
         WRITE (NOUT,*) '  Ridge  '
         WRITE (NOUT,99995) '  Coeff.  ', (I,I=1,PL)
         IF (PL.LT.LPEC) THEN
            WRITE (NOUT,99996) (I,I=PL+1,LPEC)
         END IF
         DO 120 I = 1, LH
            WRITE (NOUT,99999) H(I), (PE(J,I),J=1,PL)
            IF (PL.LT.IP) THEN
               WRITE (NOUT,99998) (PE(J,I),J=PL+1,IP)
            END IF
  120    CONTINUE
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Key:'
         DO 140 I = 1, LPEC
            IF (PEC(I).EQ.'L') THEN
               WRITE (NOUT,99992) I, 'Leave one out cross-validation'
            ELSE IF (PEC(I).EQ.'G') THEN
               WRITE (NOUT,99992) I, 'Generalised cross-validation'
            ELSE IF (PEC(I).EQ.'U') THEN
               WRITE (NOUT,99992) I, 'Unbiased estimate of variance'
            ELSE IF (PEC(I).EQ.'F') THEN
               WRITE (NOUT,99992) I, 'Final prediction error'
            ELSE IF (PEC(I).EQ.'B') THEN
               WRITE (NOUT,99992) I, 'Bayesian information criterion'
            END IF
  140    CONTINUE
      END IF
*
  160 CONTINUE
*
99999 FORMAT (F10.4,5F10.4)
99998 FORMAT (10X,5F10.4)
99997 FORMAT (A,A,4I10)
99996 FORMAT (10X,5I10)
99995 FORMAT (A,5I10)
99994 FORMAT (A,I10)
99993 FORMAT (F10.4,F10.4)
99992 FORMAT (1X,I5,1X,A)
99991 FORMAT (1X,/1X,' ** G02KBF returned with IFAIL = ',I5)
99990 FORMAT (1X,' ** Problem size too large, increase array limits')
      END