PROGRAM f02wufe

!      F02WUF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : f02wuf, nag_wp, x04cbf
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       INTEGER                         :: i, ifail, lda, ldb, ldq, lwork, n,   &
                                          ncolb
       LOGICAL                         :: wantp, wantq
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), b(:), q(:,:), sv(:), work(:)
       CHARACTER (1)                   :: clabs(1), rlabs(1)
!      .. Executable Statements ..
       WRITE (nout,*) 'F02WUF Example Program Results'
       WRITE (nout,*)
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) n, ncolb
       lda = n
       ldb = n
       ldq = n
       lwork = 5*(n-1)
       ALLOCATE (a(lda,n),b(ldb),q(ldq,n),sv(n),work(lwork))
       READ (nin,*) (a(i,i:n),i=1,n)
       READ (nin,*) b(1:n)
       wantq = .TRUE.
       wantp = .TRUE.

!      ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
       ifail = 0
!      Find the SVD of A
       CALL f02wuf(n,a,lda,ncolb,b,ldb,wantq,q,ldq,sv,wantp,work,ifail)

       WRITE (nout,*) 'Singular value decomposition of A'
       WRITE (nout,*)
       WRITE (nout,*) 'Singular values'
       WRITE (nout,99999) sv(1:n)
       WRITE (nout,*)
       FLUSH (nout)

       ifail = 0
       CALL x04cbf('General',' ',n,n,q,ldq,'F8.4', &
          'Left-hand singular vectors, by column','N',rlabs,'N',clabs,80,0, &
          ifail)

       WRITE (nout,*)
       WRITE (nout,*) 'Right-hand singular vectors, by column'
       DO i = 1, n
          WRITE (nout,99999) a(1:n,i)
       END DO
       WRITE (nout,*)
       WRITE (nout,*) 'Vector Q''*B'
       WRITE (nout,99999) b(1:n)

99999  FORMAT (1X,3(1X,F8.4))
    END PROGRAM f02wufe