PROGRAM f02xufe

!      F02XUF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : f02xuf, nag_wp, x04dbf
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       INTEGER                         :: i, ifail, lcwork, lda, ldb, ldq,     &
                                          lrwork, n, ncolb
       LOGICAL                         :: wantp, wantq
!      .. Local Arrays ..
       COMPLEX (KIND=nag_wp), ALLOCATABLE :: a(:,:), b(:), cwork(:), q(:,:)
       REAL (KIND=nag_wp), ALLOCATABLE :: rwork(:), sv(:)
       CHARACTER (1)                   :: clabs(1), rlabs(1)
!      .. Intrinsic Functions ..
       INTRINSIC                          conjg
!      .. Executable Statements ..
       WRITE (nout,*) 'F02XUF Example Program Results'
       WRITE (nout,*)
       FLUSH (nout)
!      Skip heading in data file
       READ (nin,*)
       READ (nin,*) n, ncolb
       lcwork = n - 1
       lda = n
       ldb = n
       ldq = n
       lrwork = 5*(n-1)
       ALLOCATE (a(lda,n),b(ldb),cwork(lcwork),q(ldq,n),rwork(lrwork),sv(n))
       READ (nin,*) (a(i,i:n),i=1,n)
       READ (nin,*) b(1:n)
!      Find the SVD of A.
       wantq = .TRUE.
       wantp = .TRUE.

!      ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
       ifail = 0
       CALL f02xuf(n,a,lda,ncolb,b,ldb,wantq,q,ldq,sv,wantp,rwork,cwork,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 x04dbf('General',' ',n,n,q,ldq,'Bracketed','F7.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,99998) conjg(a(1:n,i))
       END DO
       WRITE (nout,*)
       WRITE (nout,*) 'Vector conjg( Q'' )*B'
       WRITE (nout,99998) b(1:n)

99999  FORMAT (1X,3F9.4)
99998  FORMAT (3X,3('(',F7.4,',',F8.4,') ':))
    END PROGRAM f02xufe