LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dormql()

subroutine dormql ( character side,
character trans,
integer m,
integer n,
integer k,
double precision, dimension( lda, * ) a,
integer lda,
double precision, dimension( * ) tau,
double precision, dimension( ldc, * ) c,
integer ldc,
double precision, dimension( * ) work,
integer lwork,
integer info )

DORMQL

Download DORMQL + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> DORMQL overwrites the general real M-by-N matrix C with
!>
!>                 SIDE = 'L'     SIDE = 'R'
!> TRANS = 'N':      Q * C          C * Q
!> TRANS = 'T':      Q**T * C       C * Q**T
!>
!> where Q is a real orthogonal matrix defined as the product of k
!> elementary reflectors
!>
!>       Q = H(k) . . . H(2) H(1)
!>
!> as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N
!> if SIDE = 'R'.
!>
Parameters
[in]SIDE
!>          SIDE is CHARACTER*1
!>          = 'L': apply Q or Q**T from the Left;
!>          = 'R': apply Q or Q**T from the Right.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>          = 'N':  No transpose, apply Q;
!>          = 'T':  Transpose, apply Q**T.
!>
[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
!>          The number of elementary reflectors whose product defines
!>          the matrix Q.
!>          If SIDE = 'L', M >= K >= 0;
!>          if SIDE = 'R', N >= K >= 0.
!>
[in]A
!>          A is DOUBLE PRECISION array, dimension (LDA,K)
!>          The i-th column must contain the vector which defines the
!>          elementary reflector H(i), for i = 1,2,...,k, as returned by
!>          DGEQLF in the last k columns of its array argument A.
!>
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of the array A.
!>          If SIDE = 'L', LDA >= max(1,M);
!>          if SIDE = 'R', LDA >= max(1,N).
!>
[in]TAU
!>          TAU is DOUBLE PRECISION array, dimension (K)
!>          TAU(i) must contain the scalar factor of the elementary
!>          reflector H(i), as returned by DGEQLF.
!>
[in,out]C
!>          C is DOUBLE PRECISION array, dimension (LDC,N)
!>          On entry, the M-by-N matrix C.
!>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
!>
[in]LDC
!>          LDC is INTEGER
!>          The leading dimension of the array C. LDC >= max(1,M).
!>
[out]WORK
!>          WORK is DOUBLE PRECISION 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).
!>          For good performance, LWORK should generally be larger.
!>
!>          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 163 of file dormql.f.

165*
166* -- LAPACK computational routine --
167* -- LAPACK is a software package provided by Univ. of Tennessee, --
168* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
169*
170* .. Scalar Arguments ..
171 CHARACTER SIDE, TRANS
172 INTEGER INFO, K, LDA, LDC, LWORK, M, N
173* ..
174* .. Array Arguments ..
175 DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
176* ..
177*
178* =====================================================================
179*
180* .. Parameters ..
181 INTEGER NBMAX, LDT, TSIZE
182 parameter( nbmax = 64, ldt = nbmax+1,
183 $ tsize = ldt*nbmax )
184* ..
185* .. Local Scalars ..
186 LOGICAL LEFT, LQUERY, NOTRAN
187 INTEGER I, I1, I2, I3, IB, IINFO, IWT, LDWORK, LWKOPT,
188 $ MI, NB, NBMIN, NI, NQ, NW
189* ..
190* .. External Functions ..
191 LOGICAL LSAME
192 INTEGER ILAENV
193 EXTERNAL lsame, ilaenv
194* ..
195* .. External Subroutines ..
196 EXTERNAL dlarfb, dlarft, dorm2l, xerbla
197* ..
198* .. Intrinsic Functions ..
199 INTRINSIC max, min
200* ..
201* .. Executable Statements ..
202*
203* Test the input arguments
204*
205 info = 0
206 left = lsame( side, 'L' )
207 notran = lsame( trans, 'N' )
208 lquery = ( lwork.EQ.-1 )
209*
210* NQ is the order of Q and NW is the minimum dimension of WORK
211*
212 IF( left ) THEN
213 nq = m
214 nw = max( 1, n )
215 ELSE
216 nq = n
217 nw = max( 1, m )
218 END IF
219 IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
220 info = -1
221 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
222 info = -2
223 ELSE IF( m.LT.0 ) THEN
224 info = -3
225 ELSE IF( n.LT.0 ) THEN
226 info = -4
227 ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
228 info = -5
229 ELSE IF( lda.LT.max( 1, nq ) ) THEN
230 info = -7
231 ELSE IF( ldc.LT.max( 1, m ) ) THEN
232 info = -10
233 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
234 info = -12
235 END IF
236*
237 IF( info.EQ.0 ) THEN
238*
239* Compute the workspace requirements
240*
241 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
242 lwkopt = 1
243 ELSE
244 nb = min( nbmax, ilaenv( 1, 'DORMQL', side // trans, m,
245 $ n,
246 $ k, -1 ) )
247 lwkopt = nw*nb + tsize
248 END IF
249 work( 1 ) = lwkopt
250 END IF
251*
252 IF( info.NE.0 ) THEN
253 CALL xerbla( 'DORMQL', -info )
254 RETURN
255 ELSE IF( lquery ) THEN
256 RETURN
257 END IF
258*
259* Quick return if possible
260*
261 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
262 RETURN
263 END IF
264*
265 nbmin = 2
266 ldwork = nw
267 IF( nb.GT.1 .AND. nb.LT.k ) THEN
268 IF( lwork.LT.lwkopt ) THEN
269 nb = (lwork-tsize) / ldwork
270 nbmin = max( 2, ilaenv( 2, 'DORMQL', side // trans, m, n,
271 $ 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,
281 $ work,
282 $ iinfo )
283 ELSE
284*
285* Use blocked code
286*
287 iwt = 1 + nw*nb
288 IF( ( left .AND. notran ) .OR.
289 $ ( .NOT.left .AND. .NOT.notran ) ) THEN
290 i1 = 1
291 i2 = k
292 i3 = nb
293 ELSE
294 i1 = ( ( k-1 ) / nb )*nb + 1
295 i2 = 1
296 i3 = -nb
297 END IF
298*
299 IF( left ) THEN
300 ni = n
301 ELSE
302 mi = m
303 END IF
304*
305 DO 10 i = i1, i2, i3
306 ib = min( nb, k-i+1 )
307*
308* Form the triangular factor of the block reflector
309* H = H(i+ib-1) . . . H(i+1) H(i)
310*
311 CALL dlarft( 'Backward', 'Columnwise', nq-k+i+ib-1, ib,
312 $ a( 1, i ), lda, tau( i ), work( iwt ), ldt )
313 IF( left ) THEN
314*
315* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
316*
317 mi = m - k + i + ib - 1
318 ELSE
319*
320* H or H**T is applied to C(1:m,1:n-k+i+ib-1)
321*
322 ni = n - k + i + ib - 1
323 END IF
324*
325* Apply H or H**T
326*
327 CALL dlarfb( side, trans, 'Backward', 'Columnwise', mi,
328 $ ni,
329 $ ib, a( 1, i ), lda, work( iwt ), ldt, c, ldc,
330 $ work, ldwork )
331 10 CONTINUE
332 END IF
333 work( 1 ) = lwkopt
334 RETURN
335*
336* End of DORMQL
337*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:160
dlarfb
subroutine dlarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
DLARFB applies a block reflector or its transpose to a general rectangular matrix.
Definition dlarfb.f:195
dlarft
recursive subroutine dlarft(direct, storev, n, k, v, ldv, tau, t, ldt)
DLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition dlarft.f:162
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
dorm2l
subroutine dorm2l(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
DORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sge...
Definition dorm2l.f:156
Here is the call graph for this function:
Here is the caller graph for this function: