*     G02LBF Example Program Text
*     Mark 22 Release. NAG Copyright 2008.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NMAX, MXMAX, MYMAX
      PARAMETER        (NMAX=16,MXMAX=27,MYMAX=3)
*     .. Local Scalars ..
      DOUBLE PRECISION TAU
      INTEGER          I, IFAIL, IP, ISCALE, J, LDC, LDP, LDT, LDU, LDW,
     +                 LDX, LDXRES, LDY, LDYCV, LDYRES, MAXFAC, MAXIT,
     +                 MX, MY, N
*     .. Local Arrays ..
      DOUBLE PRECISION C(MYMAX,MXMAX), P(MXMAX,MXMAX), T(NMAX,MXMAX),
     +                 U(NMAX,MXMAX), W(MXMAX,MXMAX), X(NMAX,MXMAX),
     +                 XBAR(MXMAX), XCV(MXMAX), XRES(NMAX,MXMAX),
     +                 XSTD(MXMAX), Y(NMAX,MYMAX), YBAR(MYMAX),
     +                 YCV(MXMAX,MYMAX), YRES(NMAX,MYMAX), YSTD(MYMAX)
      INTEGER          ISX(MXMAX)
*     .. External Subroutines ..
      EXTERNAL         G02LBF, X04CAF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G02LBF example program results'
*     Skip header in data file.
      READ (NIN,*)
*     Read data values.
      READ (NIN,*) N, MX, MY, ISCALE, MAXFAC
*     Check array sizes
      IF ((N.GT.NMAX) .OR. (MX.GT.MXMAX) .OR. (MY.GT.MYMAX)) THEN
         WRITE (NOUT,99996)
         GO TO 80
      END IF
      LDX = NMAX
      LDY = NMAX
      LDXRES = NMAX
      LDYRES = NMAX
      LDW = MXMAX
      LDP = MXMAX
      LDT = NMAX
      LDC = MYMAX
      LDU = NMAX
      LDYCV = MXMAX
      MAXIT = 200
      TAU = 1.0D-4
*     Read data values.
      DO 20 I = 1, N
         READ (NIN,*) (X(I,J),J=1,MX), (Y(I,J),J=1,MY)
   20 CONTINUE
      READ (NIN,*) (ISX(J),J=1,MX)
      IP = 0
      DO 40 J = 1, MX
         IF (ISX(J).EQ.1) THEN
            IP = IP + 1
         END IF
   40 CONTINUE
*     Fit a PLS model.
      IFAIL = 1
      CALL G02LBF(N,MX,X,LDX,ISX,IP,MY,Y,LDY,XBAR,YBAR,ISCALE,XSTD,YSTD,
     +            MAXFAC,MAXIT,TAU,XRES,LDXRES,YRES,LDYRES,W,LDW,P,LDP,
     +            T,LDT,C,LDC,U,LDU,XCV,YCV,LDYCV,IFAIL)
      IF (IFAIL.NE.0) THEN
         WRITE (NOUT,99997) IFAIL
         GO TO 80
      END IF
      CALL X04CAF('G','X',IP,MAXFAC,P,LDP,'x-loadings, P',IFAIL)
      CALL X04CAF('G','X',N,MAXFAC,T,LDT,'x-scores, T',IFAIL)
      CALL X04CAF('G','X',MY,MAXFAC,C,LDC,'y-loadings, C',IFAIL)
      CALL X04CAF('G','X',N,MAXFAC,U,LDU,'y-scores, U',IFAIL)
      WRITE (NOUT,*)
      WRITE (NOUT,*) 'Explained Variance'
      WRITE (NOUT,99999) 'Model effects', 'Dependent variable(s)'
      DO 60 I = 1, MAXFAC
         WRITE (NOUT,99998) XCV(I), (YCV(I,J),J=1,MY)
   60 CONTINUE
*
   80 CONTINUE
*
99999 FORMAT (1X,A12,4X,A21)
99998 FORMAT (1X,10(F12.6,4X))
99997 FORMAT (1X,/1X,' ** G02LBF returned with IFAIL = ',I5)
99996 FORMAT (1X,' ** Problem size too large, increase array limits')
      END