LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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 156 of file sorgbr.f.

157 *
158 * -- LAPACK computational routine --
159 * -- LAPACK is a software package provided by Univ. of Tennessee, --
160 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
161 *
162 * .. Scalar Arguments ..
163  CHARACTER VECT
164  INTEGER INFO, K, LDA, LWORK, M, N
165 * ..
166 * .. Array Arguments ..
167  REAL A( LDA, * ), TAU( * ), WORK( * )
168 * ..
169 *
170 * =====================================================================
171 *
172 * .. Parameters ..
173  REAL ZERO, ONE
174  parameter( zero = 0.0e+0, one = 1.0e+0 )
175 * ..
176 * .. Local Scalars ..
177  LOGICAL LQUERY, WANTQ
178  INTEGER I, IINFO, J, LWKOPT, MN
179 * ..
180 * .. External Functions ..
181  LOGICAL LSAME
182  EXTERNAL lsame
183 * ..
184 * .. External Subroutines ..
185  EXTERNAL sorglq, sorgqr, xerbla
186 * ..
187 * .. Intrinsic Functions ..
188  INTRINSIC max, min
189 * ..
190 * .. Executable Statements ..
191 *
192 * Test the input arguments
193 *
194  info = 0
195  wantq = lsame( vect, 'Q' )
196  mn = min( m, n )
197  lquery = ( lwork.EQ.-1 )
198  IF( .NOT.wantq .AND. .NOT.lsame( vect, 'P' ) ) THEN
199  info = -1
200  ELSE IF( m.LT.0 ) THEN
201  info = -2
202  ELSE IF( n.LT.0 .OR. ( wantq .AND. ( n.GT.m .OR. n.LT.min( m,
203  $ k ) ) ) .OR. ( .NOT.wantq .AND. ( m.GT.n .OR. m.LT.
204  $ min( n, k ) ) ) ) THEN
205  info = -3
206  ELSE IF( k.LT.0 ) THEN
207  info = -4
208  ELSE IF( lda.LT.max( 1, m ) ) THEN
209  info = -6
210  ELSE IF( lwork.LT.max( 1, mn ) .AND. .NOT.lquery ) THEN
211  info = -9
212  END IF
213 *
214  IF( info.EQ.0 ) THEN
215  work( 1 ) = 1
216  IF( wantq ) THEN
217  IF( m.GE.k ) THEN
218  CALL sorgqr( m, n, k, a, lda, tau, work, -1, iinfo )
219  ELSE
220  IF( m.GT.1 ) THEN
221  CALL sorgqr( m-1, m-1, m-1, a, lda, tau, work, -1,
222  $ iinfo )
223  END IF
224  END IF
225  ELSE
226  IF( k.LT.n ) THEN
227  CALL sorglq( m, n, k, a, lda, tau, work, -1, iinfo )
228  ELSE
229  IF( n.GT.1 ) THEN
230  CALL sorglq( n-1, n-1, n-1, a, lda, tau, work, -1,
231  $ iinfo )
232  END IF
233  END IF
234  END IF
235  lwkopt = work( 1 )
236  lwkopt = max(lwkopt, mn)
237  END IF
238 *
239  IF( info.NE.0 ) THEN
240  CALL xerbla( 'SORGBR', -info )
241  RETURN
242  ELSE IF( lquery ) THEN
243  work( 1 ) = lwkopt
244  RETURN
245  END IF
246 *
247 * Quick return if possible
248 *
249  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
250  work( 1 ) = 1
251  RETURN
252  END IF
253 *
254  IF( wantq ) THEN
255 *
256 * Form Q, determined by a call to SGEBRD to reduce an m-by-k
257 * matrix
258 *
259  IF( m.GE.k ) THEN
260 *
261 * If m >= k, assume m >= n >= k
262 *
263  CALL sorgqr( m, n, k, a, lda, tau, work, lwork, iinfo )
264 *
265  ELSE
266 *
267 * If m < k, assume m = n
268 *
269 * Shift the vectors which define the elementary reflectors one
270 * column to the right, and set the first row and column of Q
271 * to those of the unit matrix
272 *
273  DO 20 j = m, 2, -1
274  a( 1, j ) = zero
275  DO 10 i = j + 1, m
276  a( i, j ) = a( i, j-1 )
277  10 CONTINUE
278  20 CONTINUE
279  a( 1, 1 ) = one
280  DO 30 i = 2, m
281  a( i, 1 ) = zero
282  30 CONTINUE
283  IF( m.GT.1 ) THEN
284 *
285 * Form Q(2:m,2:m)
286 *
287  CALL sorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
288  $ lwork, iinfo )
289  END IF
290  END IF
291  ELSE
292 *
293 * Form P**T, determined by a call to SGEBRD to reduce a k-by-n
294 * matrix
295 *
296  IF( k.LT.n ) THEN
297 *
298 * If k < n, assume k <= m <= n
299 *
300  CALL sorglq( m, n, k, a, lda, tau, work, lwork, iinfo )
301 *
302  ELSE
303 *
304 * If k >= n, assume m = n
305 *
306 * Shift the vectors which define the elementary reflectors one
307 * row downward, and set the first row and column of P**T to
308 * those of the unit matrix
309 *
310  a( 1, 1 ) = one
311  DO 40 i = 2, n
312  a( i, 1 ) = zero
313  40 CONTINUE
314  DO 60 j = 2, n
315  DO 50 i = j - 1, 2, -1
316  a( i, j ) = a( i-1, j )
317  50 CONTINUE
318  a( 1, j ) = zero
319  60 CONTINUE
320  IF( n.GT.1 ) THEN
321 *
322 * Form P**T(2:n,2:n)
323 *
324  CALL sorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
325  $ lwork, iinfo )
326  END IF
327  END IF
328  END IF
329  work( 1 ) = lwkopt
330  RETURN
331 *
332 * End of SORGBR
333 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine sorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGLQ
Definition: sorglq.f:127
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:128
Here is the call graph for this function:
Here is the caller graph for this function: