1*> \brief \b DORMQL 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download DORMQL + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormql.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormql.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormql.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE DORMQL( 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* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) 30* .. 31* 32* 33*> \par Purpose: 34* ============= 35*> 36*> \verbatim 37*> 38*> DORMQL overwrites the general real M-by-N matrix C with 39*> 40*> SIDE = 'L' SIDE = 'R' 41*> TRANS = 'N': Q * C C * Q 42*> TRANS = 'T': Q**T * C C * Q**T 43*> 44*> where Q is a real orthogonal matrix defined as the product of k 45*> elementary reflectors 46*> 47*> Q = H(k) . . . H(2) H(1) 48*> 49*> as returned by DGEQLF. 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**T from the Left; 60*> = 'R': apply Q or Q**T from the Right. 61*> \endverbatim 62*> 63*> \param[in] TRANS 64*> \verbatim 65*> TRANS is CHARACTER*1 66*> = 'N': No transpose, apply Q; 67*> = 'T': Transpose, apply Q**T. 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 DOUBLE PRECISION array, dimension (LDA,K) 94*> The i-th column must contain the vector which defines the 95*> elementary reflector H(i), for i = 1,2,...,k, as returned by 96*> DGEQLF in the last k columns of its array argument A. 97*> \endverbatim 98*> 99*> \param[in] LDA 100*> \verbatim 101*> LDA is INTEGER 102*> The leading dimension of the array A. 103*> If SIDE = 'L', LDA >= max(1,M); 104*> if SIDE = 'R', LDA >= max(1,N). 105*> \endverbatim 106*> 107*> \param[in] TAU 108*> \verbatim 109*> TAU is DOUBLE PRECISION array, dimension (K) 110*> TAU(i) must contain the scalar factor of the elementary 111*> reflector H(i), as returned by DGEQLF. 112*> \endverbatim 113*> 114*> \param[in,out] C 115*> \verbatim 116*> C is DOUBLE PRECISION array, dimension (LDC,N) 117*> On entry, the M-by-N matrix C. 118*> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T 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 DOUBLE PRECISION 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 doubleOTHERcomputational 163* 164* ===================================================================== 165 SUBROUTINE DORMQL( 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 DOUBLE PRECISION 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 INTEGER I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT, 190 $ MI, NB, NBMIN, NI, NQ, NW 191* .. 192* .. External Functions .. 193 LOGICAL LSAME 194 INTEGER ILAENV 195 EXTERNAL LSAME, ILAENV 196* .. 197* .. External Subroutines .. 198 EXTERNAL DLARFB, DLARFT, DORM2L, XERBLA 199* .. 200* .. Intrinsic Functions .. 201 INTRINSIC MAX, MIN 202* .. 203* .. Executable Statements .. 204* 205* Test the input arguments 206* 207 INFO = 0 208 LEFT = LSAME( SIDE, 'L' ) 209 NOTRAN = LSAME( TRANS, 'N' ) 210 LQUERY = ( LWORK.EQ.-1 ) 211* 212* NQ is the order of Q and NW is the minimum dimension of WORK 213* 214 IF( LEFT ) THEN 215 NQ = M 216 NW = MAX( 1, N ) 217 ELSE 218 NQ = N 219 NW = MAX( 1, M ) 220 END IF 221 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 222 INFO = -1 223 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN 224 INFO = -2 225 ELSE IF( M.LT.0 ) THEN 226 INFO = -3 227 ELSE IF( N.LT.0 ) THEN 228 INFO = -4 229 ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN 230 INFO = -5 231 ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN 232 INFO = -7 233 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 234 INFO = -10 235 ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN 236 INFO = -12 237 END IF 238* 239 IF( INFO.EQ.0 ) THEN 240* 241* Compute the workspace requirements 242* 243 IF( M.EQ.0 .OR. N.EQ.0 ) THEN 244 LWKOPT = 1 245 ELSE 246 NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N, 247 $ K, -1 ) ) 248 LWKOPT = NW*NB + TSIZE 249 END IF 250 WORK( 1 ) = LWKOPT 251 END IF 252* 253 IF( INFO.NE.0 ) THEN 254 CALL XERBLA( 'DORMQL', -INFO ) 255 RETURN 256 ELSE IF( LQUERY ) THEN 257 RETURN 258 END IF 259* 260* Quick return if possible 261* 262 IF( M.EQ.0 .OR. N.EQ.0 ) THEN 263 RETURN 264 END IF 265* 266 NBMIN = 2 267 LDWORK = NW 268 IF( NB.GT.1 .AND. NB.LT.K ) THEN 269 IF( LWORK.LT.LWKOPT ) THEN 270 NB = (LWORK-TSIZE) / LDWORK 271 NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K, 272 $ -1 ) ) 273 END IF 274 END IF 275* 276 IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN 277* 278* Use unblocked code 279* 280 CALL DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, 281 $ IINFO ) 282 ELSE 283* 284* Use blocked code 285* 286 IWT = 1 + NW*NB 287 IF( ( LEFT .AND. NOTRAN ) .OR. 288 $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN 289 I1 = 1 290 I2 = K 291 I3 = NB 292 ELSE 293 I1 = ( ( K-1 ) / NB )*NB + 1 294 I2 = 1 295 I3 = -NB 296 END IF 297* 298 IF( LEFT ) THEN 299 NI = N 300 ELSE 301 MI = M 302 END IF 303* 304 DO 10 I = I1, I2, I3 305 IB = MIN( NB, K-I+1 ) 306* 307* Form the triangular factor of the block reflector 308* H = H(i+ib-1) . . . H(i+1) H(i) 309* 310 CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, 311 $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT ) 312 IF( LEFT ) THEN 313* 314* H or H**T is applied to C(1:m-k+i+ib-1,1:n) 315* 316 MI = M - K + I + IB - 1 317 ELSE 318* 319* H or H**T is applied to C(1:m,1:n-k+i+ib-1) 320* 321 NI = N - K + I + IB - 1 322 END IF 323* 324* Apply H or H**T 325* 326 CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, 327 $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, 328 $ WORK, LDWORK ) 329 10 CONTINUE 330 END IF 331 WORK( 1 ) = LWKOPT 332 RETURN 333* 334* End of DORMQL 335* 336 END 337