Program f02wdfe ! F02WDF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f02wdf, nag_wp, x04cbf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: tol Integer :: i, ifail, irank, lda, ldpt, ldr, & lwork, m, n Logical :: svd, wantb, wantpt, wantr ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), pt(:,:), r(:,:), sv(:), & work(:), z(:) Character (1) :: clabs(1), rlabs(1) ! .. Executable Statements .. Write (nout,*) 'F02WDF Example Program Results' ! Skip heading in data file Read (nin,*) Read (nin,*) m, n Write (nout,*) lda = m ldpt = n ldr = n lwork = 3*n Allocate (a(lda,n),pt(ldpt,n),r(ldr,n),sv(n),work(lwork),z(n)) svd = .True. tol = 5.0E-4_nag_wp Read (nin,*)(a(i,1:n),i=1,m) wantb = .False. wantr = .True. wantpt = .True. ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 Call f02wdf(m,n,a,lda,wantb,work,tol,svd,irank,z,sv,wantr,r,ldr,wantpt, & pt,ldpt,work,lwork,ifail) Write (nout,99999) 'Rank of A is', irank Write (nout,*) Flush (nout) ifail = 0 Call x04cbf('General',' ',m,n,a,lda,'F9.3','Details of QU factorization' & ,'N',rlabs,'N',clabs,80,0,ifail) Write (nout,*) Write (nout,*) 'Vector Z' Write (nout,99998) z(1:n) Write (nout,*) Flush (nout) ifail = 0 Call x04cbf('General',' ',n,n,r,ldr,'F9.3','Matrix R','N',rlabs,'N', & clabs,80,0,ifail) Write (nout,*) Write (nout,*) 'Singular values' Write (nout,99998) sv(1:n) Write (nout,*) Flush (nout) ifail = 0 Call x04cbf('General',' ',n,n,pt,ldpt,'F9.3','Matrix P**T','N',rlabs, & 'N',clabs,80,0,ifail) 99999 Format (1X,A,I5,A,I5) 99998 Format (1X,8F9.3) End Program f02wdfe