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

◆ sormlq()

subroutine sormlq ( 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 
)

SORMLQ

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

Purpose:
 SORMLQ 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 SGELQF. 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,M) if SIDE = 'L',
                               (LDA,N) if SIDE = 'R'
          The i-th row must contain the vector which defines the
          elementary reflector H(i), for i = 1,2,...,k, as returned by
          SGELQF in the first k rows of its array argument A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A. LDA >= max(1,K).
[in]TAU
          TAU is REAL array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by SGELQF.
[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
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 166 of file sormlq.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 CHARACTER TRANST
192 INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,
193 $ LWKOPT, 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 slarfb, slarft, sorml2, 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, k ) ) 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, 'SORMLQ', side // trans, m, n, k,
247 $ -1 ) )
248 lwkopt = nw*nb + tsize
249 work( 1 ) = lwkopt
250 END IF
251*
252 IF( info.NE.0 ) THEN
253 CALL xerbla( 'SORMLQ', -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, 'SORMLQ', 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 sorml2( 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 jc = 1
301 ELSE
302 mi = m
303 ic = 1
304 END IF
305*
306 IF( notran ) THEN
307 transt = 'T'
308 ELSE
309 transt = 'N'
310 END IF
311*
312 DO 10 i = i1, i2, i3
313 ib = min( nb, k-i+1 )
314*
315* Form the triangular factor of the block reflector
316* H = H(i) H(i+1) . . . H(i+ib-1)
317*
318 CALL slarft( 'Forward', 'Rowwise', nq-i+1, ib, a( i, i ),
319 $ lda, tau( i ), work( iwt ), ldt )
320 IF( left ) THEN
321*
322* H or H**T is applied to C(i:m,1:n)
323*
324 mi = m - i + 1
325 ic = i
326 ELSE
327*
328* H or H**T is applied to C(1:m,i:n)
329*
330 ni = n - i + 1
331 jc = i
332 END IF
333*
334* Apply H or H**T
335*
336 CALL slarfb( side, transt, 'Forward', 'Rowwise', mi, ni, ib,
337 $ a( i, i ), lda, work( iwt ), ldt,
338 $ c( ic, jc ), ldc, work, ldwork )
339 10 CONTINUE
340 END IF
341 work( 1 ) = lwkopt
342 RETURN
343*
344* End of SORMLQ
345*
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
slarfb
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
slarft
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
sorml2
subroutine sorml2(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
SORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sge...
Definition: sorml2.f:159
Here is the call graph for this function:
Here is the caller graph for this function: