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

ZUNGBR

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

Purpose: 
 ZUNGBR generates one of the complex unitary matrices Q or P**H
 determined by ZGEBRD when reducing a complex matrix A to bidiagonal
 form: A = Q * B * P**H.  Q and P**H 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 ZUNGBR returns the first n
 columns of Q, where m >= n >= k;
 if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an
 M-by-M matrix.

 If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H
 is of order N:
 if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m
 rows of P**H, where n >= m >= k;
 if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as
 an N-by-N matrix.
Parameters
[in]VECT
          VECT is CHARACTER*1
          Specifies whether the matrix Q or the matrix P**H is
          required, as defined in the transformation applied by ZGEBRD:
          = 'Q':  generate Q;
          = 'P':  generate P**H.
[in]M
          M is INTEGER
          The number of rows of the matrix Q or P**H to be returned.
          M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix Q or P**H 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 ZGEBRD.
          If VECT = 'P', the number of rows in the original K-by-N
          matrix reduced by ZGEBRD.
          K >= 0.
[in,out]A
          A is COMPLEX*16 array, dimension (LDA,N)
          On entry, the vectors which define the elementary reflectors,
          as returned by ZGEBRD.
          On exit, the M-by-N matrix Q or P**H.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A. LDA >= M.
[in]TAU
          TAU is COMPLEX*16 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**H, as
          returned by ZGEBRD in its array argument TAUQ or TAUP.
[out]WORK
          WORK is COMPLEX*16 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 zungbr.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  COMPLEX*16 a( lda, * ), tau( * ), work( * )
171 * ..
172 *
173 * =====================================================================
174 *
175 * .. Parameters ..
176  COMPLEX*16 zero, one
177  parameter ( zero = ( 0.0d+0, 0.0d+0 ),
178  $ one = ( 1.0d+0, 0.0d+0 ) )
179 * ..
180 * .. Local Scalars ..
181  LOGICAL lquery, wantq
182  INTEGER i, iinfo, j, lwkopt, mn
183 * ..
184 * .. External Functions ..
185  LOGICAL lsame
186  INTEGER ilaenv
187  EXTERNAL lsame, ilaenv
188 * ..
189 * .. External Subroutines ..
190  EXTERNAL xerbla, zunglq, zungqr
191 * ..
192 * .. Intrinsic Functions ..
193  INTRINSIC max, min
194 * ..
195 * .. Executable Statements ..
196 *
197 * Test the input arguments
198 *
199  info = 0
200  wantq = lsame( vect, 'Q' )
201  mn = min( m, n )
202  lquery = ( lwork.EQ.-1 )
203  IF( .NOT.wantq .AND. .NOT.lsame( vect, 'P' ) ) THEN
204  info = -1
205  ELSE IF( m.LT.0 ) THEN
206  info = -2
207  ELSE IF( n.LT.0 .OR. ( wantq .AND. ( n.GT.m .OR. n.LT.min( m,
208  $ k ) ) ) .OR. ( .NOT.wantq .AND. ( m.GT.n .OR. m.LT.
209  $ min( n, k ) ) ) ) THEN
210  info = -3
211  ELSE IF( k.LT.0 ) THEN
212  info = -4
213  ELSE IF( lda.LT.max( 1, m ) ) THEN
214  info = -6
215  ELSE IF( lwork.LT.max( 1, mn ) .AND. .NOT.lquery ) THEN
216  info = -9
217  END IF
218 *
219  IF( info.EQ.0 ) THEN
220  work( 1 ) = 1
221  IF( wantq ) THEN
222  IF( m.GE.k ) THEN
223  CALL zungqr( m, n, k, a, lda, tau, work, -1, iinfo )
224  ELSE
225  IF( m.GT.1 ) THEN
226  CALL zungqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
227  $ -1, iinfo )
228  END IF
229  END IF
230  ELSE
231  IF( k.LT.n ) THEN
232  CALL zunglq( m, n, k, a, lda, tau, work, -1, iinfo )
233  ELSE
234  IF( n.GT.1 ) THEN
235  CALL zunglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
236  $ -1, iinfo )
237  END IF
238  END IF
239  END IF
240  lwkopt = work( 1 )
241  lwkopt = max(lwkopt, mn)
242  END IF
243 *
244  IF( info.NE.0 ) THEN
245  CALL xerbla( 'ZUNGBR', -info )
246  RETURN
247  ELSE IF( lquery ) THEN
248  work( 1 ) = lwkopt
249  RETURN
250  END IF
251 *
252 * Quick return if possible
253 *
254  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
255  work( 1 ) = 1
256  RETURN
257  END IF
258 *
259  IF( wantq ) THEN
260 *
261 * Form Q, determined by a call to ZGEBRD to reduce an m-by-k
262 * matrix
263 *
264  IF( m.GE.k ) THEN
265 *
266 * If m >= k, assume m >= n >= k
267 *
268  CALL zungqr( m, n, k, a, lda, tau, work, lwork, iinfo )
269 *
270  ELSE
271 *
272 * If m < k, assume m = n
273 *
274 * Shift the vectors which define the elementary reflectors one
275 * column to the right, and set the first row and column of Q
276 * to those of the unit matrix
277 *
278  DO 20 j = m, 2, -1
279  a( 1, j ) = zero
280  DO 10 i = j + 1, m
281  a( i, j ) = a( i, j-1 )
282  10 CONTINUE
283  20 CONTINUE
284  a( 1, 1 ) = one
285  DO 30 i = 2, m
286  a( i, 1 ) = zero
287  30 CONTINUE
288  IF( m.GT.1 ) THEN
289 *
290 * Form Q(2:m,2:m)
291 *
292  CALL zungqr( m-1, m-1, m-1, a( 2, 2 ), lda, tau, work,
293  $ lwork, iinfo )
294  END IF
295  END IF
296  ELSE
297 *
298 * Form P**H, determined by a call to ZGEBRD to reduce a k-by-n
299 * matrix
300 *
301  IF( k.LT.n ) THEN
302 *
303 * If k < n, assume k <= m <= n
304 *
305  CALL zunglq( m, n, k, a, lda, tau, work, lwork, iinfo )
306 *
307  ELSE
308 *
309 * If k >= n, assume m = n
310 *
311 * Shift the vectors which define the elementary reflectors one
312 * row downward, and set the first row and column of P**H to
313 * those of the unit matrix
314 *
315  a( 1, 1 ) = one
316  DO 40 i = 2, n
317  a( i, 1 ) = zero
318  40 CONTINUE
319  DO 60 j = 2, n
320  DO 50 i = j - 1, 2, -1
321  a( i, j ) = a( i-1, j )
322  50 CONTINUE
323  a( 1, j ) = zero
324  60 CONTINUE
325  IF( n.GT.1 ) THEN
326 *
327 * Form P**H(2:n,2:n)
328 *
329  CALL zunglq( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
330  $ lwork, iinfo )
331  END IF
332  END IF
333  END IF
334  work( 1 ) = lwkopt
335  RETURN
336 *
337 * End of ZUNGBR
338 *
zunglq
subroutine zunglq(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGLQ
Definition: zunglq.f:129
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
zungqr
subroutine zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
Definition: zungqr.f:130
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
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: