LAPACK  3.7.0
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.7.0) --
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  EXTERNAL lsame
186 * ..
187 * .. External Subroutines ..
188  EXTERNAL dorglq, dorgqr, xerbla
189 * ..
190 * .. Intrinsic Functions ..
191  INTRINSIC max, min
192 * ..
193 * .. Executable Statements ..
194 *
195 * Test the input arguments
196 *
197  info = 0
198  wantq = lsame( vect, 'Q' )
199  mn = min( m, n )
200  lquery = ( lwork.EQ.-1 )
201  IF( .NOT.wantq .AND. .NOT.lsame( vect, 'P' ) ) THEN
202  info = -1
203  ELSE IF( m.LT.0 ) THEN
204  info = -2
205  ELSE IF( n.LT.0 .OR. ( wantq .AND. ( n.GT.m .OR. n.LT.min( m,
206  $ k ) ) ) .OR. ( .NOT.wantq .AND. ( m.GT.n .OR. m.LT.
207  $ min( n, k ) ) ) ) THEN
208  info = -3
209  ELSE IF( k.LT.0 ) THEN
210  info = -4
211  ELSE IF( lda.LT.max( 1, m ) ) THEN
212  info = -6
213  ELSE IF( lwork.LT.max( 1, mn ) .AND. .NOT.lquery ) THEN
214  info = -9
215  END IF
216 *
217  IF( info.EQ.0 ) THEN
218  work( 1 ) = 1
219  IF( wantq ) THEN
220  IF( m.GE.k ) THEN
221  CALL dorgqr( m, n, k, a, lda, tau, work, -1, iinfo )
222  ELSE
223  IF( m.GT.1 ) THEN
224  CALL dorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
225  $ -1, iinfo )
226  END IF
227  END IF
228  ELSE
229  IF( k.LT.n ) THEN
230  CALL dorglq( m, n, k, a, lda, tau, work, -1, iinfo )
231  ELSE
232  IF( n.GT.1 ) THEN
233  CALL dorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
234  $ -1, iinfo )
235  END IF
236  END IF
237  END IF
238  lwkopt = work( 1 )
239  lwkopt = max(lwkopt, mn)
240  END IF
241 *
242  IF( info.NE.0 ) THEN
243  CALL xerbla( 'DORGBR', -info )
244  RETURN
245  ELSE IF( lquery ) THEN
246  work( 1 ) = lwkopt
247  RETURN
248  END IF
249 *
250 * Quick return if possible
251 *
252  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
253  work( 1 ) = 1
254  RETURN
255  END IF
256 *
257  IF( wantq ) THEN
258 *
259 * Form Q, determined by a call to DGEBRD to reduce an m-by-k
260 * matrix
261 *
262  IF( m.GE.k ) THEN
263 *
264 * If m >= k, assume m >= n >= k
265 *
266  CALL dorgqr( m, n, k, a, lda, tau, work, lwork, iinfo )
267 *
268  ELSE
269 *
270 * If m < k, assume m = n
271 *
272 * Shift the vectors which define the elementary reflectors one
273 * column to the right, and set the first row and column of Q
274 * to those of the unit matrix
275 *
276  DO 20 j = m, 2, -1
277  a( 1, j ) = zero
278  DO 10 i = j + 1, m
279  a( i, j ) = a( i, j-1 )
280  10 CONTINUE
281  20 CONTINUE
282  a( 1, 1 ) = one
283  DO 30 i = 2, m
284  a( i, 1 ) = zero
285  30 CONTINUE
286  IF( m.GT.1 ) THEN
287 *
288 * Form Q(2:m,2:m)
289 *
290  CALL dorgqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
291  $ lwork, iinfo )
292  END IF
293  END IF
294  ELSE
295 *
296 * Form P**T, determined by a call to DGEBRD to reduce a k-by-n
297 * matrix
298 *
299  IF( k.LT.n ) THEN
300 *
301 * If k < n, assume k <= m <= n
302 *
303  CALL dorglq( m, n, k, a, lda, tau, work, lwork, iinfo )
304 *
305  ELSE
306 *
307 * If k >= n, assume m = n
308 *
309 * Shift the vectors which define the elementary reflectors one
310 * row downward, and set the first row and column of P**T to
311 * those of the unit matrix
312 *
313  a( 1, 1 ) = one
314  DO 40 i = 2, n
315  a( i, 1 ) = zero
316  40 CONTINUE
317  DO 60 j = 2, n
318  DO 50 i = j - 1, 2, -1
319  a( i, j ) = a( i-1, j )
320  50 CONTINUE
321  a( 1, j ) = zero
322  60 CONTINUE
323  IF( n.GT.1 ) THEN
324 *
325 * Form P**T(2:n,2:n)
326 *
327  CALL dorglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
328  $ lwork, iinfo )
329  END IF
330  END IF
331  END IF
332  work( 1 ) = lwkopt
333  RETURN
334 *
335 * End of DORGBR
336 *
dorglq
subroutine dorglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGLQ
Definition: dorglq.f:129
dorgqr
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: