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

◆ cunmbr()

subroutine cunmbr ( character  vect,
character  side,
character  trans,
integer  m,
integer  n,
integer  k,
complex, dimension( lda, * )  a,
integer  lda,
complex, dimension( * )  tau,
complex, dimension( ldc, * )  c,
integer  ldc,
complex, dimension( * )  work,
integer  lwork,
integer  info 
)

CUNMBR

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

Purpose:
 If VECT = 'Q', CUNMBR overwrites the general complex M-by-N matrix C
 with
                 SIDE = 'L'     SIDE = 'R'
 TRANS = 'N':      Q * C          C * Q
 TRANS = 'C':      Q**H * C       C * Q**H

 If VECT = 'P', CUNMBR overwrites the general complex M-by-N matrix C
 with
                 SIDE = 'L'     SIDE = 'R'
 TRANS = 'N':      P * C          C * P
 TRANS = 'C':      P**H * C       C * P**H

 Here Q and P**H are the unitary matrices 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) and
 G(i) respectively.

 Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
 order of the unitary matrix Q or P**H that is applied.

 If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
 if nq >= k, Q = H(1) H(2) . . . H(k);
 if nq < k, Q = H(1) H(2) . . . H(nq-1).

 If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
 if k < nq, P = G(1) G(2) . . . G(k);
 if k >= nq, P = G(1) G(2) . . . G(nq-1).
Parameters
[in]VECT
          VECT is CHARACTER*1
          = 'Q': apply Q or Q**H;
          = 'P': apply P or P**H.
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': apply Q, Q**H, P or P**H from the Left;
          = 'R': apply Q, Q**H, P or P**H from the Right.
[in]TRANS
          TRANS is CHARACTER*1
          = 'N':  No transpose, apply Q or P;
          = 'C':  Conjugate transpose, apply Q**H or P**H.
[in]M
          M is INTEGER
          The number of rows of the matrix C. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix C. N >= 0.
[in]K
          K is INTEGER
          If VECT = 'Q', the number of columns in the original
          matrix reduced by CGEBRD.
          If VECT = 'P', the number of rows in the original
          matrix reduced by CGEBRD.
          K >= 0.
[in]A
          A is COMPLEX array, dimension
                                (LDA,min(nq,K)) if VECT = 'Q'
                                (LDA,nq)        if VECT = 'P'
          The vectors which define the elementary reflectors H(i) and
          G(i), whose products determine the matrices Q and P, as
          returned by CGEBRD.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.
          If VECT = 'Q', LDA >= max(1,nq);
          if VECT = 'P', LDA >= max(1,min(nq,K)).
[in]TAU
          TAU is COMPLEX array, dimension (min(nq,K))
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i) or G(i) which determines Q or P, as returned
          by CGEBRD in the array argument TAUQ or TAUP.
[in,out]C
          C is COMPLEX array, dimension (LDC,N)
          On entry, the M-by-N matrix C.
          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q
          or P*C or P**H*C or C*P or C*P**H.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[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.
          If SIDE = 'L', LWORK >= max(1,N);
          if SIDE = 'R', LWORK >= max(1,M);
          if N = 0 or M = 0, LWORK >= 1.
          For optimum performance LWORK >= max(1,N*NB) if SIDE = 'L',
          and LWORK >= max(1,M*NB) if SIDE = 'R', where NB is the
          optimal blocksize. (NB = 0 if M = 0 or N = 0.)

          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 195 of file cunmbr.f.

197*
198* -- LAPACK computational routine --
199* -- LAPACK is a software package provided by Univ. of Tennessee, --
200* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
201*
202* .. Scalar Arguments ..
203 CHARACTER SIDE, TRANS, VECT
204 INTEGER INFO, K, LDA, LDC, LWORK, M, N
205* ..
206* .. Array Arguments ..
207 COMPLEX A( LDA, * ), C( LDC, * ), TAU( * ),
208 $ WORK( * )
209* ..
210*
211* =====================================================================
212*
213* .. Local Scalars ..
214 LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
215 CHARACTER TRANST
216 INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
217* ..
218* .. External Functions ..
219 LOGICAL LSAME
220 INTEGER ILAENV
221 REAL SROUNDUP_LWORK
222 EXTERNAL ilaenv, lsame, sroundup_lwork
223* ..
224* .. External Subroutines ..
225 EXTERNAL cunmlq, cunmqr, xerbla
226* ..
227* .. Intrinsic Functions ..
228 INTRINSIC max, min
229* ..
230* .. Executable Statements ..
231*
232* Test the input arguments
233*
234 info = 0
235 applyq = lsame( vect, 'Q' )
236 left = lsame( side, 'L' )
237 notran = lsame( trans, 'N' )
238 lquery = ( lwork.EQ.-1 )
239*
240* NQ is the order of Q or P and NW is the minimum dimension of WORK
241*
242 IF( left ) THEN
243 nq = m
244 nw = max( 1, n )
245 ELSE
246 nq = n
247 nw = max( 1, m )
248 END IF
249 IF( .NOT.applyq .AND. .NOT.lsame( vect, 'P' ) ) THEN
250 info = -1
251 ELSE IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
252 info = -2
253 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
254 info = -3
255 ELSE IF( m.LT.0 ) THEN
256 info = -4
257 ELSE IF( n.LT.0 ) THEN
258 info = -5
259 ELSE IF( k.LT.0 ) THEN
260 info = -6
261 ELSE IF( ( applyq .AND. lda.LT.max( 1, nq ) ) .OR.
262 $ ( .NOT.applyq .AND. lda.LT.max( 1, min( nq, k ) ) ) )
263 $ THEN
264 info = -8
265 ELSE IF( ldc.LT.max( 1, m ) ) THEN
266 info = -11
267 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
268 info = -13
269 END IF
270*
271 IF( info.EQ.0 ) THEN
272 IF( m.GT.0 .AND. n.GT.0 ) THEN
273 IF( applyq ) THEN
274 IF( left ) THEN
275 nb = ilaenv( 1, 'CUNMQR', side // trans, m-1, n, m-1,
276 $ -1 )
277 ELSE
278 nb = ilaenv( 1, 'CUNMQR', side // trans, m, n-1, n-1,
279 $ -1 )
280 END IF
281 ELSE
282 IF( left ) THEN
283 nb = ilaenv( 1, 'CUNMLQ', side // trans, m-1, n, m-1,
284 $ -1 )
285 ELSE
286 nb = ilaenv( 1, 'CUNMLQ', side // trans, m, n-1, n-1,
287 $ -1 )
288 END IF
289 END IF
290 lwkopt = nw*nb
291 ELSE
292 lwkopt = 1
293 END IF
294 work( 1 ) = sroundup_lwork(lwkopt)
295 END IF
296*
297 IF( info.NE.0 ) THEN
298 CALL xerbla( 'CUNMBR', -info )
299 RETURN
300 ELSE IF( lquery ) THEN
301 RETURN
302 END IF
303*
304* Quick return if possible
305*
306 IF( m.EQ.0 .OR. n.EQ.0 )
307 $ RETURN
308*
309 IF( applyq ) THEN
310*
311* Apply Q
312*
313 IF( nq.GE.k ) THEN
314*
315* Q was determined by a call to CGEBRD with nq >= k
316*
317 CALL cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,
318 $ work, lwork, iinfo )
319 ELSE IF( nq.GT.1 ) THEN
320*
321* Q was determined by a call to CGEBRD with nq < k
322*
323 IF( left ) THEN
324 mi = m - 1
325 ni = n
326 i1 = 2
327 i2 = 1
328 ELSE
329 mi = m
330 ni = n - 1
331 i1 = 1
332 i2 = 2
333 END IF
334 CALL cunmqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
335 $ c( i1, i2 ), ldc, work, lwork, iinfo )
336 END IF
337 ELSE
338*
339* Apply P
340*
341 IF( notran ) THEN
342 transt = 'C'
343 ELSE
344 transt = 'N'
345 END IF
346 IF( nq.GT.k ) THEN
347*
348* P was determined by a call to CGEBRD with nq > k
349*
350 CALL cunmlq( side, transt, m, n, k, a, lda, tau, c, ldc,
351 $ work, lwork, iinfo )
352 ELSE IF( nq.GT.1 ) THEN
353*
354* P was determined by a call to CGEBRD with nq <= k
355*
356 IF( left ) THEN
357 mi = m - 1
358 ni = n
359 i1 = 2
360 i2 = 1
361 ELSE
362 mi = m
363 ni = n - 1
364 i1 = 1
365 i2 = 2
366 END IF
367 CALL cunmlq( side, transt, mi, ni, nq-1, a( 1, 2 ), lda,
368 $ tau, c( i1, i2 ), ldc, work, lwork, iinfo )
369 END IF
370 END IF
371 work( 1 ) = sroundup_lwork(lwkopt)
372 RETURN
373*
374* End of CUNMBR
375*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
subroutine cunmlq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMLQ
Definition cunmlq.f:168
subroutine cunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMQR
Definition cunmqr.f:168
Here is the call graph for this function:
Here is the caller graph for this function: