* 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