1*> \brief \b ZUNMLQ 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download ZUNMLQ + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunmlq.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunmlq.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunmlq.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, 22* WORK, LWORK, INFO ) 23* 24* .. Scalar Arguments .. 25* CHARACTER SIDE, TRANS 26* INTEGER INFO, K, LDA, LDC, LWORK, M, N 27* .. 28* .. Array Arguments .. 29* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) 30* .. 31* 32* 33*> \par Purpose: 34* ============= 35*> 36*> \verbatim 37*> 38*> ZUNMLQ overwrites the general complex M-by-N matrix C with 39*> 40*> SIDE = 'L' SIDE = 'R' 41*> TRANS = 'N': Q * C C * Q 42*> TRANS = 'C': Q**H * C C * Q**H 43*> 44*> where Q is a complex unitary matrix defined as the product of k 45*> elementary reflectors 46*> 47*> Q = H(k)**H . . . H(2)**H H(1)**H 48*> 49*> as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N 50*> if SIDE = 'R'. 51*> \endverbatim 52* 53* Arguments: 54* ========== 55* 56*> \param[in] SIDE 57*> \verbatim 58*> SIDE is CHARACTER*1 59*> = 'L': apply Q or Q**H from the Left; 60*> = 'R': apply Q or Q**H from the Right. 61*> \endverbatim 62*> 63*> \param[in] TRANS 64*> \verbatim 65*> TRANS is CHARACTER*1 66*> = 'N': No transpose, apply Q; 67*> = 'C': Conjugate transpose, apply Q**H. 68*> \endverbatim 69*> 70*> \param[in] M 71*> \verbatim 72*> M is INTEGER 73*> The number of rows of the matrix C. M >= 0. 74*> \endverbatim 75*> 76*> \param[in] N 77*> \verbatim 78*> N is INTEGER 79*> The number of columns of the matrix C. N >= 0. 80*> \endverbatim 81*> 82*> \param[in] K 83*> \verbatim 84*> K is INTEGER 85*> The number of elementary reflectors whose product defines 86*> the matrix Q. 87*> If SIDE = 'L', M >= K >= 0; 88*> if SIDE = 'R', N >= K >= 0. 89*> \endverbatim 90*> 91*> \param[in] A 92*> \verbatim 93*> A is COMPLEX*16 array, dimension 94*> (LDA,M) if SIDE = 'L', 95*> (LDA,N) if SIDE = 'R' 96*> The i-th row must contain the vector which defines the 97*> elementary reflector H(i), for i = 1,2,...,k, as returned by 98*> ZGELQF in the first k rows of its array argument A. 99*> \endverbatim 100*> 101*> \param[in] LDA 102*> \verbatim 103*> LDA is INTEGER 104*> The leading dimension of the array A. LDA >= max(1,K). 105*> \endverbatim 106*> 107*> \param[in] TAU 108*> \verbatim 109*> TAU is COMPLEX*16 array, dimension (K) 110*> TAU(i) must contain the scalar factor of the elementary 111*> reflector H(i), as returned by ZGELQF. 112*> \endverbatim 113*> 114*> \param[in,out] C 115*> \verbatim 116*> C is COMPLEX*16 array, dimension (LDC,N) 117*> On entry, the M-by-N matrix C. 118*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. 119*> \endverbatim 120*> 121*> \param[in] LDC 122*> \verbatim 123*> LDC is INTEGER 124*> The leading dimension of the array C. LDC >= max(1,M). 125*> \endverbatim 126*> 127*> \param[out] WORK 128*> \verbatim 129*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) 130*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 131*> \endverbatim 132*> 133*> \param[in] LWORK 134*> \verbatim 135*> LWORK is INTEGER 136*> The dimension of the array WORK. 137*> If SIDE = 'L', LWORK >= max(1,N); 138*> if SIDE = 'R', LWORK >= max(1,M). 139*> For good performance, LWORK should generally be larger. 140*> 141*> If LWORK = -1, then a workspace query is assumed; the routine 142*> only calculates the optimal size of the WORK array, returns 143*> this value as the first entry of the WORK array, and no error 144*> message related to LWORK is issued by XERBLA. 145*> \endverbatim 146*> 147*> \param[out] INFO 148*> \verbatim 149*> INFO is INTEGER 150*> = 0: successful exit 151*> < 0: if INFO = -i, the i-th argument had an illegal value 152*> \endverbatim 153* 154* Authors: 155* ======== 156* 157*> \author Univ. of Tennessee 158*> \author Univ. of California Berkeley 159*> \author Univ. of Colorado Denver 160*> \author NAG Ltd. 161* 162*> \ingroup complex16OTHERcomputational 163* 164* ===================================================================== 165 SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, 166 $ WORK, LWORK, INFO ) 167* 168* -- LAPACK computational routine -- 169* -- LAPACK is a software package provided by Univ. of Tennessee, -- 170* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 171* 172* .. Scalar Arguments .. 173 CHARACTER SIDE, TRANS 174 INTEGER INFO, K, LDA, LDC, LWORK, M, N 175* .. 176* .. Array Arguments .. 177 COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) 178* .. 179* 180* ===================================================================== 181* 182* .. Parameters .. 183 INTEGER NBMAX, LDT, TSIZE 184 PARAMETER ( NBMAX = 64, LDT = NBMAX+1, 185 $ TSIZE = LDT*NBMAX ) 186* .. 187* .. Local Scalars .. 188 LOGICAL LEFT, LQUERY, NOTRAN 189 CHARACTER TRANST 190 INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK, 191 $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW 192* .. 193* .. External Functions .. 194 LOGICAL LSAME 195 INTEGER ILAENV 196 EXTERNAL LSAME, ILAENV 197* .. 198* .. External Subroutines .. 199 EXTERNAL XERBLA, ZLARFB, ZLARFT, ZUNML2 200* .. 201* .. Intrinsic Functions .. 202 INTRINSIC MAX, MIN 203* .. 204* .. Executable Statements .. 205* 206* Test the input arguments 207* 208 INFO = 0 209 LEFT = LSAME( SIDE, 'L' ) 210 NOTRAN = LSAME( TRANS, 'N' ) 211 LQUERY = ( LWORK.EQ.-1 ) 212* 213* NQ is the order of Q and NW is the minimum dimension of WORK 214* 215 IF( LEFT ) THEN 216 NQ = M 217 NW = MAX( 1, N ) 218 ELSE 219 NQ = N 220 NW = MAX( 1, M ) 221 END IF 222 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 223 INFO = -1 224 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 225 INFO = -2 226 ELSE IF( M.LT.0 ) THEN 227 INFO = -3 228 ELSE IF( N.LT.0 ) THEN 229 INFO = -4 230 ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN 231 INFO = -5 232 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN 233 INFO = -7 234 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 235 INFO = -10 236 ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN 237 INFO = -12 238 END IF 239* 240 IF( INFO.EQ.0 ) THEN 241* 242* Compute the workspace requirements 243* 244 NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, K, 245 $ -1 ) ) 246 LWKOPT = NW*NB + TSIZE 247 WORK( 1 ) = LWKOPT 248 END IF 249* 250 IF( INFO.NE.0 ) THEN 251 CALL XERBLA( 'ZUNMLQ', -INFO ) 252 RETURN 253 ELSE IF( LQUERY ) THEN 254 RETURN 255 END IF 256* 257* Quick return if possible 258* 259 IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN 260 WORK( 1 ) = 1 261 RETURN 262 END IF 263* 264 NBMIN = 2 265 LDWORK = NW 266 IF( NB.GT.1 .AND. NB.LT.K ) THEN 267 IF( LWORK.LT.LWKOPT ) THEN 268 NB = (LWORK-TSIZE) / LDWORK 269 NBMIN = MAX( 2, ILAENV( 2, 'ZUNMLQ', SIDE // TRANS, M, N, K, 270 $ -1 ) ) 271 END IF 272 END IF 273* 274 IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN 275* 276* Use unblocked code 277* 278 CALL ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, 279 $ IINFO ) 280 ELSE 281* 282* Use blocked code 283* 284 IWT = 1 + NW*NB 285 IF( ( LEFT .AND. NOTRAN ) .OR. 286 $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN 287 I1 = 1 288 I2 = K 289 I3 = NB 290 ELSE 291 I1 = ( ( K-1 ) / NB )*NB + 1 292 I2 = 1 293 I3 = -NB 294 END IF 295* 296 IF( LEFT ) THEN 297 NI = N 298 JC = 1 299 ELSE 300 MI = M 301 IC = 1 302 END IF 303* 304 IF( NOTRAN ) THEN 305 TRANST = 'C' 306 ELSE 307 TRANST = 'N' 308 END IF 309* 310 DO 10 I = I1, I2, I3 311 IB = MIN( NB, K-I+1 ) 312* 313* Form the triangular factor of the block reflector 314* H = H(i) H(i+1) . . . H(i+ib-1) 315* 316 CALL ZLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ), 317 $ LDA, TAU( I ), WORK( IWT ), LDT ) 318 IF( LEFT ) THEN 319* 320* H or H**H is applied to C(i:m,1:n) 321* 322 MI = M - I + 1 323 IC = I 324 ELSE 325* 326* H or H**H is applied to C(1:m,i:n) 327* 328 NI = N - I + 1 329 JC = I 330 END IF 331* 332* Apply H or H**H 333* 334 CALL ZLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB, 335 $ A( I, I ), LDA, WORK( IWT ), LDT, 336 $ C( IC, JC ), LDC, WORK, LDWORK ) 337 10 CONTINUE 338 END IF 339 WORK( 1 ) = LWKOPT 340 RETURN 341* 342* End of ZUNMLQ 343* 344 END 345