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

◆ sormql()

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

SORMQL

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

Purpose:
 SORMQL 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 SGEQLF. 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
          SGEQLF 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 REAL array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by SGEQLF.
[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 sormql.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, IINFO, IWT, LDWORK, LWKOPT,
192 $ 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, sorm2l, 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, 'SORMQL', side // trans, m, n,
250 $ k, -1 ) )
251 lwkopt = nw*nb + tsize
252 END IF
253 work( 1 ) = sroundup_lwork(lwkopt)
254 END IF
255*
256 IF( info.NE.0 ) THEN
257 CALL xerbla( 'SORMQL', -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.lwkopt ) THEN
273 nb = (lwork-tsize) / ldwork
274 nbmin = max( 2, ilaenv( 2, 'SORMQL', 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 sorm2l( 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 slarft( '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 slarfb( 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 ) = sroundup_lwork(lwkopt)
335 RETURN
336*
337* End of SORMQL
338*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
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
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
sroundup_lwork
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
Definition sroundup_lwork.f:59
sorm2l
subroutine sorm2l(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
SORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sge...
Definition sorm2l.f:159
Here is the call graph for this function:
Here is the caller graph for this function: