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

## ◆ cungbr()

 subroutine cungbr ( character vect, integer m, integer n, integer k, complex, dimension( lda, * ) a, integer lda, complex, dimension( * ) tau, complex, dimension( * ) work, integer lwork, integer info )

CUNGBR

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

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