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*> \date December 2016 163* 164*> \ingroup doubleOTHERcomputational 165* 166* ===================================================================== 167 SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, 168 $ WORK, LWORK, INFO ) 169* 170* -- LAPACK computational routine (version 3.7.0) -- 171* -- LAPACK is a software package provided by Univ. of Tennessee, -- 172* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 173* December 2016 174* 175* .. Scalar Arguments .. 176 CHARACTER SIDE, TRANS 177 INTEGER INFO, K, LDA, LDC, LWORK, M, N 178* .. 179* .. Array Arguments .. 180 DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) 181* .. 182* 183* ===================================================================== 184* 185* .. Parameters .. 186 INTEGER NBMAX, LDT, TSIZE 187 PARAMETER ( NBMAX = 64, LDT = NBMAX+1, 188 $ TSIZE = LDT*NBMAX ) 189* .. 190* .. Local Scalars .. 191 LOGICAL LEFT, LQUERY, NOTRAN 192 INTEGER I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT, 193 $ MI, NB, NBMIN, NI, NQ, NW 194* .. 195* .. External Functions .. 196 LOGICAL LSAME 197 INTEGER ILAENV 198 EXTERNAL LSAME, ILAENV 199* .. 200* .. External Subroutines .. 201 EXTERNAL DLARFB, DLARFT, DORM2L, XERBLA 202* .. 203* .. Intrinsic Functions .. 204 INTRINSIC MAX, MIN 205* .. 206* .. Executable Statements .. 207* 208* Test the input arguments 209* 210 INFO = 0 211 LEFT = LSAME( SIDE, 'L' ) 212 NOTRAN = LSAME( TRANS, 'N' ) 213 LQUERY = ( LWORK.EQ.-1 ) 214* 215* NQ is the order of Q and NW is the minimum dimension of WORK 216* 217 IF( LEFT ) THEN 218 NQ = M 219 NW = MAX( 1, N ) 220 ELSE 221 NQ = N 222 NW = MAX( 1, M ) 223 END IF 224 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 225 INFO = -1 226 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN 227 INFO = -2 228 ELSE IF( M.LT.0 ) THEN 229 INFO = -3 230 ELSE IF( N.LT.0 ) THEN 231 INFO = -4 232 ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN 233 INFO = -5 234 ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN 235 INFO = -7 236 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 237 INFO = -10 238 ELSE IF( LWORK.LT.NW .AND. .NOT.LQUERY ) THEN 239 INFO = -12 240 END IF 241* 242 IF( INFO.EQ.0 ) THEN 243* 244* Compute the workspace requirements 245* 246 IF( M.EQ.0 .OR. N.EQ.0 ) THEN 247 LWKOPT = 1 248 ELSE 249 NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N, 250 $ K, -1 ) ) 251 LWKOPT = NW*NB + TSIZE 252 END IF 253 WORK( 1 ) = LWKOPT 254 END IF 255* 256 IF( INFO.NE.0 ) THEN 257 CALL XERBLA( 'DORMQL', -INFO ) 258 RETURN 259 ELSE IF( LQUERY ) THEN 260 RETURN 261 END IF 262* 263* Quick return if possible 264* 265 IF( M.EQ.0 .OR. N.EQ.0 ) THEN 266 RETURN 267 END IF 268* 269 NBMIN = 2 270 LDWORK = NW 271 IF( NB.GT.1 .AND. NB.LT.K ) THEN 272 IF( LWORK.LT.NW*NB+TSIZE ) THEN 273 NB = (LWORK-TSIZE) / LDWORK 274 NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K, 275 $ -1 ) ) 276 END IF 277 END IF 278* 279 IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN 280* 281* Use unblocked code 282* 283 CALL DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, 284 $ IINFO ) 285 ELSE 286* 287* Use blocked code 288* 289 IWT = 1 + NW*NB 290 IF( ( LEFT .AND. NOTRAN ) .OR. 291 $ ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN 292 I1 = 1 293 I2 = K 294 I3 = NB 295 ELSE 296 I1 = ( ( K-1 ) / NB )*NB + 1 297 I2 = 1 298 I3 = -NB 299 END IF 300* 301 IF( LEFT ) THEN 302 NI = N 303 ELSE 304 MI = M 305 END IF 306* 307 DO 10 I = I1, I2, I3 308 IB = MIN( NB, K-I+1 ) 309* 310* Form the triangular factor of the block reflector 311* H = H(i+ib-1) . . . H(i+1) H(i) 312* 313 CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, 314 $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT ) 315 IF( LEFT ) THEN 316* 317* H or H**T is applied to C(1:m-k+i+ib-1,1:n) 318* 319 MI = M - K + I + IB - 1 320 ELSE 321* 322* H or H**T is applied to C(1:m,1:n-k+i+ib-1) 323* 324 NI = N - K + I + IB - 1 325 END IF 326* 327* Apply H or H**T 328* 329 CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, 330 $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, 331 $ WORK, LDWORK ) 332 10 CONTINUE 333 END IF 334 WORK( 1 ) = LWKOPT 335 RETURN 336* 337* End of DORMQL 338* 339 END 340