LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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 = int( 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: