sorgbr()

subroutine sorgbr	(	character	vect,
		integer	m,
		integer	n,
		integer	k,
		real, dimension( lda, * )	a,
		integer	lda,
		real, dimension( * )	tau,
		real, dimension( * )	work,
		integer	lwork,
		integer	info )

SORGBR

Download SORGBR + dependencies [TGZ] [ZIP] [TXT]

Purpose:

!>
!> SORGBR generates one of the real orthogonal matrices Q or P**T
!> determined by SGEBRD when reducing a real matrix A to bidiagonal
!> form: A = Q * B * P**T.  Q and P**T are defined as products of
!> elementary reflectors H(i) or G(i) respectively.
!>
!> If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
!> is of order M:
!> if m >= k, Q = H(1) H(2) . . . H(k) and SORGBR returns the first n
!> columns of Q, where m >= n >= k;
!> if m < k, Q = H(1) H(2) . . . H(m-1) and SORGBR returns Q as an
!> M-by-M matrix.
!>
!> If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
!> is of order N:
!> if k < n, P**T = G(k) . . . G(2) G(1) and SORGBR returns the first m
!> rows of P**T, where n >= m >= k;
!> if k >= n, P**T = G(n-1) . . . G(2) G(1) and SORGBR returns P**T as
!> an N-by-N matrix.
!> 

Parameters

[in]	VECT	!> VECT is CHARACTER*1 !> Specifies whether the matrix Q or the matrix P**T is !> required, as defined in the transformation applied by SGEBRD: !> = 'Q': generate Q; !> = 'P': generate P**T. !>
[in]	M	!> M is INTEGER !> The number of rows of the matrix Q or P**T to be returned. !> M >= 0. !>
[in]	N	!> N is INTEGER !> The number of columns of the matrix Q or P**T to be returned. !> N >= 0. !> If VECT = 'Q', M >= N >= min(M,K); !> if VECT = 'P', N >= M >= min(N,K). !>
[in]	K	!> K is INTEGER !> If VECT = 'Q', the number of columns in the original M-by-K !> matrix reduced by SGEBRD. !> If VECT = 'P', the number of rows in the original K-by-N !> matrix reduced by SGEBRD. !> K >= 0. !>
[in,out]	A	!> A is REAL array, dimension (LDA,N) !> On entry, the vectors which define the elementary reflectors, !> as returned by SGEBRD. !> On exit, the M-by-N matrix Q or P**T. !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1,M). !>
[in]	TAU	!> TAU is REAL array, dimension !> (min(M,K)) if VECT = 'Q' !> (min(N,K)) if VECT = 'P' !> TAU(i) must contain the scalar factor of the elementary !> reflector H(i) or G(i), which determines Q or P**T, as !> returned by SGEBRD in its array argument TAUQ or TAUP. !>
[out]	WORK	!> WORK is REAL array, dimension (MAX(1,LWORK)) !> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. !>
[in]	LWORK	!> LWORK is INTEGER !> The dimension of the array WORK. LWORK >= max(1,min(M,N)). !> For optimum performance LWORK >= min(M,N)*NB, where NB !> is the optimal blocksize. !> !> If LWORK = -1, then a workspace query is assumed; the routine !> only calculates the optimal size of the WORK array, returns !> this value as the first entry of the WORK array, and no error !> message related to LWORK is issued by XERBLA. !>
[out]	INFO	!> INFO is INTEGER !> = 0: successful exit !> < 0: if INFO = -i, the i-th argument had an illegal value !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 154 of file sorgbr.f.

*
*  -- LAPACK computational routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          VECT
      INTEGER            INFO, K, LDA, LWORK, M, N
*     ..
*     .. Array Arguments ..
      REAL               A( LDA, * ), TAU( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0e+0, one = 1.0e+0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            LQUERY, WANTQ
      INTEGER            I, IINFO, J, LWKOPT, MN
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      REAL               SROUNDUP_LWORK
      EXTERNAL           lsame, sroundup_lwork
*     ..
*     .. External Subroutines ..
      EXTERNAL           sorglq, sorgqr, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          max, min
*     ..
*     .. Executable Statements ..
*
*     Test the input arguments
*
      info = 0
      wantq = lsame( vect, 'Q' )
      mn = min( m, n )
      lquery = ( lwork.EQ.-1 )
      IF( .NOT.wantq .AND. .NOT.lsame( vect, 'P' ) ) THEN
         info = -1
      ELSE IF( m.LT.0 ) THEN
         info = -2
      ELSE IF( n.LT.0 .OR. ( wantq .AND. ( n.GT.m .OR. n.LT.min( m,
     $         k ) ) ) .OR. ( .NOT.wantq .AND. ( m.GT.n .OR. m.LT.
     $         min( n, k ) ) ) ) THEN
         info = -3
      ELSE IF( k.LT.0 ) THEN
         info = -4
      ELSE IF( lda.LT.max( 1, m ) ) THEN
         info = -6
      ELSE IF( lwork.LT.max( 1, mn ) .AND. .NOT.lquery ) THEN
         info = -9
      END IF
*
      IF( info.EQ.0 ) THEN
         work( 1 ) = 1
         IF( wantq ) THEN
            IF( m.GE.k ) THEN
               CALL sorgqr( m, n, k, a, lda, tau, work, -1, iinfo )
            ELSE
               IF( m.GT.1 ) THEN
                  CALL sorgqr( m-1, m-1, m-1, a, lda, tau, work, -1,
     $                         iinfo )
               END IF
            END IF
         ELSE
            IF( k.LT.n ) THEN
               CALL sorglq( m, n, k, a, lda, tau, work, -1, iinfo )
            ELSE
               IF( n.GT.1 ) THEN
                  CALL sorglq( n-1, n-1, n-1, a, lda, tau, work, -1,
     $                         iinfo )
               END IF
            END IF
         END IF
         lwkopt = int( work( 1 ) )
         lwkopt = max(lwkopt, mn)
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SORGBR', -info )
         RETURN
      ELSE IF( lquery ) THEN
         work( 1 ) = sroundup_lwork(lwkopt)
         RETURN
      END IF
*
*     Quick return if possible
*
      IF( m.EQ.0 .OR. n.EQ.0 ) THEN
         work( 1 ) = 1
         RETURN
      END IF
*
      IF( wantq ) THEN
*
*        Form Q, determined by a call to SGEBRD to reduce an m-by-k
*        matrix
*
         IF( m.GE.k ) THEN
*
*           If m >= k, assume m >= n >= k
*
            CALL sorgqr( m, n, k, a, lda, tau, work, lwork, iinfo )
*
         ELSE
*
*           If m < k, assume m = n
*
*           Shift the vectors which define the elementary reflectors one
*           column to the right, and set the first row and column of Q
*           to those of the unit matrix
*
            DO 20 j = m, 2, -1
               a( 1, j ) = zero
               DO 10 i = j + 1, m
                  a( i, j ) = a( i, j-1 )
   10          CONTINUE
   20       CONTINUE
            a( 1, 1 ) = one
            DO 30 i = 2, m
               a( i, 1 ) = zero
   30       CONTINUE
            IF( m.GT.1 ) THEN
*
*              Form Q(2:m,2:m)
*
               CALL sorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
     $                      lwork, iinfo )
            END IF
         END IF
      ELSE
*
*        Form P**T, determined by a call to SGEBRD to reduce a k-by-n
*        matrix
*
         IF( k.LT.n ) THEN
*
*           If k < n, assume k <= m <= n
*
            CALL sorglq( m, n, k, a, lda, tau, work, lwork, iinfo )
*
         ELSE
*
*           If k >= n, assume m = n
*
*           Shift the vectors which define the elementary reflectors one
*           row downward, and set the first row and column of P**T to
*           those of the unit matrix
*
            a( 1, 1 ) = one
            DO 40 i = 2, n
               a( i, 1 ) = zero
   40       CONTINUE
            DO 60 j = 2, n
               DO 50 i = j - 1, 2, -1
                  a( i, j ) = a( i-1, j )
   50          CONTINUE
               a( 1, j ) = zero
   60       CONTINUE
            IF( n.GT.1 ) THEN
*
*              Form P**T(2:n,2:n)
*
               CALL sorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
     $                      lwork, iinfo )
            END IF
         END IF
      END IF
      work( 1 ) = sroundup_lwork(lwkopt)
      RETURN
*
*     End of SORGBR
*

Here is the call graph for this function:

Here is the caller graph for this function: