LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ sormqr()

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

SORMQR

Purpose:
SORMQR 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(1) H(2) . . . H(k)

as returned by SGEQRF. 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 REAL 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 SGEQRF in the first 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 REAL array, dimension (K) TAU(i) must contain the scalar factor of the elementary reflector H(i), as returned by SGEQRF. [in,out] C C is REAL 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 REAL 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

Definition at line 166 of file sormqr.f.

168*
169* -- LAPACK computational routine --
170* -- LAPACK is a software package provided by Univ. of Tennessee, --
171* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172*
173* .. Scalar Arguments ..
174 CHARACTER SIDE, TRANS
175 INTEGER INFO, K, LDA, LDC, LWORK, M, N
176* ..
177* .. Array Arguments ..
178 REAL A( LDA, * ), C( LDC, * ), TAU( * ),
179 \$ WORK( * )
180* ..
181*
182* =====================================================================
183*
184* .. Parameters ..
185 INTEGER NBMAX, LDT, TSIZE
186 parameter( nbmax = 64, ldt = nbmax+1,
187 \$ tsize = ldt*nbmax )
188* ..
189* .. Local Scalars ..
190 LOGICAL LEFT, LQUERY, NOTRAN
191 INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,
192 \$ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
193* ..
194* .. External Functions ..
195 LOGICAL LSAME
196 INTEGER ILAENV
197 REAL SROUNDUP_LWORK
198 EXTERNAL lsame, ilaenv, sroundup_lwork
199* ..
200* .. External Subroutines ..
201 EXTERNAL slarfb, slarft, sorm2r, 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 nb = min( nbmax, ilaenv( 1, 'SORMQR', side // trans, m, n, k,
247 \$ -1 ) )
248 lwkopt = nw*nb + tsize
249 work( 1 ) = sroundup_lwork(lwkopt)
250 END IF
251*
252 IF( info.NE.0 ) THEN
253 CALL xerbla( 'SORMQR', -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 .OR. k.EQ.0 ) THEN
262 work( 1 ) = 1
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, 'SORMQR', 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 sorm2r( 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. .NOT.notran ) .OR.
288 \$ ( .NOT.left .AND. 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 jc = 1
301 ELSE
302 mi = m
303 ic = 1
304 END IF
305*
306 DO 10 i = i1, i2, i3
307 ib = min( nb, k-i+1 )
308*
309* Form the triangular factor of the block reflector
310* H = H(i) H(i+1) . . . H(i+ib-1)
311*
312 CALL slarft( 'Forward', 'Columnwise', nq-i+1, ib, a( i, i ),
313 \$ lda, tau( i ), work( iwt ), ldt )
314 IF( left ) THEN
315*
316* H or H**T is applied to C(i:m,1:n)
317*
318 mi = m - i + 1
319 ic = i
320 ELSE
321*
322* H or H**T is applied to C(1:m,i:n)
323*
324 ni = n - i + 1
325 jc = i
326 END IF
327*
328* Apply H or H**T
329*
330 CALL slarfb( side, trans, 'Forward', 'Columnwise', mi, ni,
331 \$ ib, a( i, i ), lda, work( iwt ), ldt,
332 \$ c( ic, jc ), ldc, work, ldwork )
333 10 CONTINUE
334 END IF
335 work( 1 ) = sroundup_lwork(lwkopt)
336 RETURN
337*
338* End of SORMQR
339*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
subroutine slarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
SLARFB applies a block reflector or its transpose to a general rectangular matrix.
Definition slarfb.f:197
subroutine slarft(direct, storev, n, k, v, ldv, tau, t, ldt)
SLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition slarft.f:163
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
subroutine sorm2r(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
SORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sge...
Definition sorm2r.f:159
Here is the call graph for this function:
Here is the caller graph for this function: