LAPACK 3.11.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 EXTERNAL ilaenv, lsame
222* ..
223* .. External Subroutines ..
224 EXTERNAL cunmlq, cunmqr, xerbla
225* ..
226* .. Intrinsic Functions ..
227 INTRINSIC max, min
228* ..
229* .. Executable Statements ..
230*
231* Test the input arguments
232*
233 info = 0
234 applyq = lsame( vect, 'Q' )
235 left = lsame( side, 'L' )
236 notran = lsame( trans, 'N' )
237 lquery = ( lwork.EQ.-1 )
238*
239* NQ is the order of Q or P and NW is the minimum dimension of WORK
240*
241 IF( left ) THEN
242 nq = m
243 nw = max( 1, n )
244 ELSE
245 nq = n
246 nw = max( 1, m )
247 END IF
248 IF( .NOT.applyq .AND. .NOT.lsame( vect, 'P' ) ) THEN
249 info = -1
250 ELSE IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
251 info = -2
252 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
253 info = -3
254 ELSE IF( m.LT.0 ) THEN
255 info = -4
256 ELSE IF( n.LT.0 ) THEN
257 info = -5
258 ELSE IF( k.LT.0 ) THEN
259 info = -6
260 ELSE IF( ( applyq .AND. lda.LT.max( 1, nq ) ) .OR.
261 $ ( .NOT.applyq .AND. lda.LT.max( 1, min( nq, k ) ) ) )
262 $ THEN
263 info = -8
264 ELSE IF( ldc.LT.max( 1, m ) ) THEN
265 info = -11
266 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
267 info = -13
268 END IF
269*
270 IF( info.EQ.0 ) THEN
271 IF( m.GT.0 .AND. n.GT.0 ) THEN
272 IF( applyq ) THEN
273 IF( left ) THEN
274 nb = ilaenv( 1, 'CUNMQR', side // trans, m-1, n, m-1,
275 $ -1 )
276 ELSE
277 nb = ilaenv( 1, 'CUNMQR', side // trans, m, n-1, n-1,
278 $ -1 )
279 END IF
280 ELSE
281 IF( left ) THEN
282 nb = ilaenv( 1, 'CUNMLQ', side // trans, m-1, n, m-1,
283 $ -1 )
284 ELSE
285 nb = ilaenv( 1, 'CUNMLQ', side // trans, m, n-1, n-1,
286 $ -1 )
287 END IF
288 END IF
289 lwkopt = nw*nb
290 ELSE
291 lwkopt = 1
292 END IF
293 work( 1 ) = lwkopt
294 END IF
295*
296 IF( info.NE.0 ) THEN
297 CALL xerbla( 'CUNMBR', -info )
298 RETURN
299 ELSE IF( lquery ) THEN
300 RETURN
301 END IF
302*
303* Quick return if possible
304*
305 IF( m.EQ.0 .OR. n.EQ.0 )
306 $ RETURN
307*
308 IF( applyq ) THEN
309*
310* Apply Q
311*
312 IF( nq.GE.k ) THEN
313*
314* Q was determined by a call to CGEBRD with nq >= k
315*
316 CALL cunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,
317 $ work, lwork, iinfo )
318 ELSE IF( nq.GT.1 ) THEN
319*
320* Q was determined by a call to CGEBRD with nq < k
321*
322 IF( left ) THEN
323 mi = m - 1
324 ni = n
325 i1 = 2
326 i2 = 1
327 ELSE
328 mi = m
329 ni = n - 1
330 i1 = 1
331 i2 = 2
332 END IF
333 CALL cunmqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
334 $ c( i1, i2 ), ldc, work, lwork, iinfo )
335 END IF
336 ELSE
337*
338* Apply P
339*
340 IF( notran ) THEN
341 transt = 'C'
342 ELSE
343 transt = 'N'
344 END IF
345 IF( nq.GT.k ) THEN
346*
347* P was determined by a call to CGEBRD with nq > k
348*
349 CALL cunmlq( side, transt, m, n, k, a, lda, tau, c, ldc,
350 $ work, lwork, iinfo )
351 ELSE IF( nq.GT.1 ) THEN
352*
353* P was determined by a call to CGEBRD with nq <= k
354*
355 IF( left ) THEN
356 mi = m - 1
357 ni = n
358 i1 = 2
359 i2 = 1
360 ELSE
361 mi = m
362 ni = n - 1
363 i1 = 1
364 i2 = 2
365 END IF
366 CALL cunmlq( side, transt, mi, ni, nq-1, a( 1, 2 ), lda,
367 $ tau, c( i1, i2 ), ldc, work, lwork, iinfo )
368 END IF
369 END IF
370 work( 1 ) = lwkopt
371 RETURN
372*
373* End of CUNMBR
374*
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
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: