1*> \brief \b CUNMBR 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CUNMBR + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cunmbr.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cunmbr.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cunmbr.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE CUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, 22* LDC, WORK, LWORK, INFO ) 23* 24* .. Scalar Arguments .. 25* CHARACTER SIDE, TRANS, VECT 26* INTEGER INFO, K, LDA, LDC, LWORK, M, N 27* .. 28* .. Array Arguments .. 29* COMPLEX A( LDA, * ), C( LDC, * ), TAU( * ), 30* $ WORK( * ) 31* .. 32* 33* 34*> \par Purpose: 35* ============= 36*> 37*> \verbatim 38*> 39*> If VECT = 'Q', CUNMBR overwrites the general complex M-by-N matrix C 40*> with 41*> SIDE = 'L' SIDE = 'R' 42*> TRANS = 'N': Q * C C * Q 43*> TRANS = 'C': Q**H * C C * Q**H 44*> 45*> If VECT = 'P', CUNMBR overwrites the general complex M-by-N matrix C 46*> with 47*> SIDE = 'L' SIDE = 'R' 48*> TRANS = 'N': P * C C * P 49*> TRANS = 'C': P**H * C C * P**H 50*> 51*> Here Q and P**H are the unitary matrices determined by CGEBRD when 52*> reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q 53*> and P**H are defined as products of elementary reflectors H(i) and 54*> G(i) respectively. 55*> 56*> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the 57*> order of the unitary matrix Q or P**H that is applied. 58*> 59*> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: 60*> if nq >= k, Q = H(1) H(2) . . . H(k); 61*> if nq < k, Q = H(1) H(2) . . . H(nq-1). 62*> 63*> If VECT = 'P', A is assumed to have been a K-by-NQ matrix: 64*> if k < nq, P = G(1) G(2) . . . G(k); 65*> if k >= nq, P = G(1) G(2) . . . G(nq-1). 66*> \endverbatim 67* 68* Arguments: 69* ========== 70* 71*> \param[in] VECT 72*> \verbatim 73*> VECT is CHARACTER*1 74*> = 'Q': apply Q or Q**H; 75*> = 'P': apply P or P**H. 76*> \endverbatim 77*> 78*> \param[in] SIDE 79*> \verbatim 80*> SIDE is CHARACTER*1 81*> = 'L': apply Q, Q**H, P or P**H from the Left; 82*> = 'R': apply Q, Q**H, P or P**H from the Right. 83*> \endverbatim 84*> 85*> \param[in] TRANS 86*> \verbatim 87*> TRANS is CHARACTER*1 88*> = 'N': No transpose, apply Q or P; 89*> = 'C': Conjugate transpose, apply Q**H or P**H. 90*> \endverbatim 91*> 92*> \param[in] M 93*> \verbatim 94*> M is INTEGER 95*> The number of rows of the matrix C. M >= 0. 96*> \endverbatim 97*> 98*> \param[in] N 99*> \verbatim 100*> N is INTEGER 101*> The number of columns of the matrix C. N >= 0. 102*> \endverbatim 103*> 104*> \param[in] K 105*> \verbatim 106*> K is INTEGER 107*> If VECT = 'Q', the number of columns in the original 108*> matrix reduced by CGEBRD. 109*> If VECT = 'P', the number of rows in the original 110*> matrix reduced by CGEBRD. 111*> K >= 0. 112*> \endverbatim 113*> 114*> \param[in] A 115*> \verbatim 116*> A is COMPLEX array, dimension 117*> (LDA,min(nq,K)) if VECT = 'Q' 118*> (LDA,nq) if VECT = 'P' 119*> The vectors which define the elementary reflectors H(i) and 120*> G(i), whose products determine the matrices Q and P, as 121*> returned by CGEBRD. 122*> \endverbatim 123*> 124*> \param[in] LDA 125*> \verbatim 126*> LDA is INTEGER 127*> The leading dimension of the array A. 128*> If VECT = 'Q', LDA >= max(1,nq); 129*> if VECT = 'P', LDA >= max(1,min(nq,K)). 130*> \endverbatim 131*> 132*> \param[in] TAU 133*> \verbatim 134*> TAU is COMPLEX array, dimension (min(nq,K)) 135*> TAU(i) must contain the scalar factor of the elementary 136*> reflector H(i) or G(i) which determines Q or P, as returned 137*> by CGEBRD in the array argument TAUQ or TAUP. 138*> \endverbatim 139*> 140*> \param[in,out] C 141*> \verbatim 142*> C is COMPLEX array, dimension (LDC,N) 143*> On entry, the M-by-N matrix C. 144*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q 145*> or P*C or P**H*C or C*P or C*P**H. 146*> \endverbatim 147*> 148*> \param[in] LDC 149*> \verbatim 150*> LDC is INTEGER 151*> The leading dimension of the array C. LDC >= max(1,M). 152*> \endverbatim 153*> 154*> \param[out] WORK 155*> \verbatim 156*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) 157*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 158*> \endverbatim 159*> 160*> \param[in] LWORK 161*> \verbatim 162*> LWORK is INTEGER 163*> The dimension of the array WORK. 164*> If SIDE = 'L', LWORK >= max(1,N); 165*> if SIDE = 'R', LWORK >= max(1,M); 166*> if N = 0 or M = 0, LWORK >= 1. 167*> For optimum performance LWORK >= max(1,N*NB) if SIDE = 'L', 168*> and LWORK >= max(1,M*NB) if SIDE = 'R', where NB is the 169*> optimal blocksize. (NB = 0 if M = 0 or N = 0.) 170*> 171*> If LWORK = -1, then a workspace query is assumed; the routine 172*> only calculates the optimal size of the WORK array, returns 173*> this value as the first entry of the WORK array, and no error 174*> message related to LWORK is issued by XERBLA. 175*> \endverbatim 176*> 177*> \param[out] INFO 178*> \verbatim 179*> INFO is INTEGER 180*> = 0: successful exit 181*> < 0: if INFO = -i, the i-th argument had an illegal value 182*> \endverbatim 183* 184* Authors: 185* ======== 186* 187*> \author Univ. of Tennessee 188*> \author Univ. of California Berkeley 189*> \author Univ. of Colorado Denver 190*> \author NAG Ltd. 191* 192*> \ingroup complexOTHERcomputational 193* 194* ===================================================================== 195 SUBROUTINE CUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, 196 $ LDC, WORK, LWORK, INFO ) 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* 375 END 376