LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dorgbr ( character  VECT,
integer  M,
integer  N,
integer  K,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  TAU,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DORGBR

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

Purpose:
 DORGBR generates one of the real orthogonal matrices Q or P**T
 determined by DGEBRD 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 DORGBR returns the first n
 columns of Q, where m >= n >= k;
 if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR 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 DORGBR 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 DORGBR 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 DGEBRD:
          = '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 DGEBRD.
          If VECT = 'P', the number of rows in the original K-by-N
          matrix reduced by DGEBRD.
          K >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA,N)
          On entry, the vectors which define the elementary reflectors,
          as returned by DGEBRD.
          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 DOUBLE PRECISION 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 DGEBRD in its array argument TAUQ or TAUP.
[out]WORK
          WORK is DOUBLE PRECISION 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.
Date
April 2012

Definition at line 159 of file dorgbr.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: