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

◆ sormrq()

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

SORMRQ

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

Purpose:
 SORMRQ 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 SGERQF. 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
          SGERQF in the last 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 SGERQF.
[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 sormrq.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, 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 slarfb, slarft, sormr2, 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 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
247 lwkopt = 1
248 ELSE
249 nb = min( nbmax, ilaenv( 1, 'SORMRQ', 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( 'SORMRQ', -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, 'SORMRQ', 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 sormr2( 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. .NOT.notran ) .OR.
291 $ ( .NOT.left .AND. 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 IF( notran ) THEN
308 transt = 'T'
309 ELSE
310 transt = 'N'
311 END IF
312*
313 DO 10 i = i1, i2, i3
314 ib = min( nb, k-i+1 )
315*
316* Form the triangular factor of the block reflector
317* H = H(i+ib-1) . . . H(i+1) H(i)
318*
319 CALL slarft( 'Backward', 'Rowwise', nq-k+i+ib-1, ib,
320 $ a( i, 1 ), lda, tau( i ), work( iwt ), ldt )
321 IF( left ) THEN
322*
323* H or H**T is applied to C(1:m-k+i+ib-1,1:n)
324*
325 mi = m - k + i + ib - 1
326 ELSE
327*
328* H or H**T is applied to C(1:m,1:n-k+i+ib-1)
329*
330 ni = n - k + i + ib - 1
331 END IF
332*
333* Apply H or H**T
334*
335 CALL slarfb( side, transt, 'Backward', 'Rowwise', mi, ni,
336 $ ib, a( i, 1 ), lda, work( iwt ), ldt, c, ldc,
337 $ work, ldwork )
338 10 CONTINUE
339 END IF
340 work( 1 ) = lwkopt
341 RETURN
342*
343* End of SORMRQ
344*
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
sormr2
subroutine sormr2(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
SORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sge...
Definition: sormr2.f:159
Here is the call graph for this function:
Here is the caller graph for this function: