LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zungbr()

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.

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