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

◆ 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 = int( dble( 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)
Definition cblat2.f:3285
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
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: