*     F02WDF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          MMAX, NMAX, LDA, LDR, LDPT, LWORK
      PARAMETER        (MMAX=10,NMAX=8,LDA=MMAX,LDR=NMAX,LDPT=NMAX,
     +                 LWORK=3*NMAX)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION TOL
      INTEGER          I, IFAIL, IRANK, J, M, N
      LOGICAL          SVD, WANTB, WANTPT, WANTR
*     .. Local Arrays ..
      DOUBLE PRECISION A(LDA,NMAX), PT(LDPT,NMAX), R(LDR,NMAX),
     +                 SV(NMAX), WORK(LWORK), Z(NMAX)
*     .. External Subroutines ..
      EXTERNAL         F02WDF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'F02WDF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) M, N
      WRITE (NOUT,*)
      IF (N.LT.1 .OR. N.GT.NMAX .OR. M.LT.1 .OR. M.GT.MMAX) THEN
         WRITE (NOUT,99999) 'N or M out of range: N = ', N, '  M = ', M
         GO TO 80
      END IF
      SVD = .TRUE.
      TOL = 5.0D-4
      READ (NIN,*) ((A(I,J),J=1,N),I=1,M)
      WANTB = .FALSE.
      WANTR = .TRUE.
      WANTPT = .TRUE.
      IFAIL = 1
*
      CALL F02WDF(M,N,A,LDA,WANTB,WORK,TOL,SVD,IRANK,Z,SV,WANTR,R,LDR,
     +            WANTPT,PT,LDPT,WORK,LWORK,IFAIL)
*
      IF (IFAIL.EQ.0) THEN
         WRITE (NOUT,99999) 'Rank of A is', IRANK
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Details of QU factorization'
         DO 20 I = 1, M
            WRITE (NOUT,99998) (A(I,J),J=1,N)
   20    CONTINUE
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Vector Z'
         WRITE (NOUT,99998) (Z(I),I=1,N)
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Matrix R'
         DO 40 I = 1, N
            WRITE (NOUT,99998) (R(I,J),J=1,N)
   40    CONTINUE
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Singular values'
         WRITE (NOUT,99998) (SV(I),I=1,N)
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Matrix P**T'
         DO 60 I = 1, N
            WRITE (NOUT,99998) (PT(I,J),J=1,N)
   60    CONTINUE
      ELSE
         WRITE (NOUT,99997) IFAIL
      END IF
   80 CONTINUE
*
99999 FORMAT (1X,A,I5,A,I5)
99998 FORMAT (1X,8F9.3)
99997 FORMAT (1X,' ** F02WDF returned with IFAIL = ',I5)
      END
