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

◆ sormrz()

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

SORMRZ

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

Purpose:
 SORMRZ 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 STZRZF. 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]L
          L is INTEGER
          The number of columns of the matrix A containing
          the meaningful part of the Householder reflectors.
          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 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
          STZRZF in the last k rows of its array argument A.
          A is modified by the routine but restored on exit.
[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 STZRZF.
[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**H*C or C*Q**H 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.
Contributors:
A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
Further Details:

Definition at line 185 of file sormrz.f.

187*
188* -- LAPACK computational routine --
189* -- LAPACK is a software package provided by Univ. of Tennessee, --
190* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191*
192* .. Scalar Arguments ..
193 CHARACTER SIDE, TRANS
194 INTEGER INFO, K, L, LDA, LDC, LWORK, M, N
195* ..
196* .. Array Arguments ..
197 REAL A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
198* ..
199*
200* =====================================================================
201*
202* .. Parameters ..
203 INTEGER NBMAX, LDT, TSIZE
204 parameter( nbmax = 64, ldt = nbmax+1,
205 $ tsize = ldt*nbmax )
206* ..
207* .. Local Scalars ..
208 LOGICAL LEFT, LQUERY, NOTRAN
209 CHARACTER TRANST
210 INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JA, JC,
211 $ LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
212* ..
213* .. External Functions ..
214 LOGICAL LSAME
215 INTEGER ILAENV
216 REAL SROUNDUP_LWORK
217 EXTERNAL lsame, ilaenv, sroundup_lwork
218* ..
219* .. External Subroutines ..
220 EXTERNAL slarzb, slarzt, sormr3, xerbla
221* ..
222* .. Intrinsic Functions ..
223 INTRINSIC max, min
224* ..
225* .. Executable Statements ..
226*
227* Test the input arguments
228*
229 info = 0
230 left = lsame( side, 'L' )
231 notran = lsame( trans, 'N' )
232 lquery = ( lwork.EQ.-1 )
233*
234* NQ is the order of Q and NW is the minimum dimension of WORK
235*
236 IF( left ) THEN
237 nq = m
238 nw = max( 1, n )
239 ELSE
240 nq = n
241 nw = max( 1, m )
242 END IF
243 IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
244 info = -1
245 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
246 info = -2
247 ELSE IF( m.LT.0 ) THEN
248 info = -3
249 ELSE IF( n.LT.0 ) THEN
250 info = -4
251 ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
252 info = -5
253 ELSE IF( l.LT.0 .OR. ( left .AND. ( l.GT.m ) ) .OR.
254 $ ( .NOT.left .AND. ( l.GT.n ) ) ) THEN
255 info = -6
256 ELSE IF( lda.LT.max( 1, k ) ) THEN
257 info = -8
258 ELSE IF( ldc.LT.max( 1, m ) ) THEN
259 info = -11
260 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
261 info = -13
262 END IF
263*
264 IF( info.EQ.0 ) THEN
265*
266* Compute the workspace requirements
267*
268 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
269 lwkopt = 1
270 ELSE
271 nb = min( nbmax, ilaenv( 1, 'SORMRQ', side // trans, m, n,
272 $ k, -1 ) )
273 lwkopt = nw*nb + tsize
274 END IF
275 work( 1 ) = sroundup_lwork(lwkopt)
276 END IF
277*
278 IF( info.NE.0 ) THEN
279 CALL xerbla( 'SORMRZ', -info )
280 RETURN
281 ELSE IF( lquery ) THEN
282 RETURN
283 END IF
284*
285* Quick return if possible
286*
287 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
288 RETURN
289 END IF
290*
291 nbmin = 2
292 ldwork = nw
293 IF( nb.GT.1 .AND. nb.LT.k ) THEN
294 IF( lwork.LT.lwkopt ) THEN
295 nb = (lwork-tsize) / ldwork
296 nbmin = max( 2, ilaenv( 2, 'SORMRQ', side // trans, m, n, k,
297 $ -1 ) )
298 END IF
299 END IF
300*
301 IF( nb.LT.nbmin .OR. nb.GE.k ) THEN
302*
303* Use unblocked code
304*
305 CALL sormr3( side, trans, m, n, k, l, a, lda, tau, c, ldc,
306 $ work, iinfo )
307 ELSE
308*
309* Use blocked code
310*
311 iwt = 1 + nw*nb
312 IF( ( left .AND. .NOT.notran ) .OR.
313 $ ( .NOT.left .AND. notran ) ) THEN
314 i1 = 1
315 i2 = k
316 i3 = nb
317 ELSE
318 i1 = ( ( k-1 ) / nb )*nb + 1
319 i2 = 1
320 i3 = -nb
321 END IF
322*
323 IF( left ) THEN
324 ni = n
325 jc = 1
326 ja = m - l + 1
327 ELSE
328 mi = m
329 ic = 1
330 ja = n - l + 1
331 END IF
332*
333 IF( notran ) THEN
334 transt = 'T'
335 ELSE
336 transt = 'N'
337 END IF
338*
339 DO 10 i = i1, i2, i3
340 ib = min( nb, k-i+1 )
341*
342* Form the triangular factor of the block reflector
343* H = H(i+ib-1) . . . H(i+1) H(i)
344*
345 CALL slarzt( 'Backward', 'Rowwise', l, ib, a( i, ja ), lda,
346 $ tau( i ), work( iwt ), ldt )
347*
348 IF( left ) THEN
349*
350* H or H**T is applied to C(i:m,1:n)
351*
352 mi = m - i + 1
353 ic = i
354 ELSE
355*
356* H or H**T is applied to C(1:m,i:n)
357*
358 ni = n - i + 1
359 jc = i
360 END IF
361*
362* Apply H or H**T
363*
364 CALL slarzb( side, transt, 'Backward', 'Rowwise', mi, ni,
365 $ ib, l, a( i, ja ), lda, work( iwt ), ldt,
366 $ c( ic, jc ), ldc, work, ldwork )
367 10 CONTINUE
368*
369 END IF
370*
371 work( 1 ) = sroundup_lwork(lwkopt)
372*
373 RETURN
374*
375* End of SORMRZ
376*
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
slarzb
subroutine slarzb(side, trans, direct, storev, m, n, k, l, v, ldv, t, ldt, c, ldc, work, ldwork)
SLARZB applies a block reflector or its transpose to a general matrix.
Definition slarzb.f:183
slarzt
subroutine slarzt(direct, storev, n, k, v, ldv, tau, t, ldt)
SLARZT forms the triangular factor T of a block reflector H = I - vtvH.
Definition slarzt.f:185
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
sormr3
subroutine sormr3(side, trans, m, n, k, l, a, lda, tau, c, ldc, work, info)
SORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stz...
Definition sormr3.f:178
Here is the call graph for this function:
Here is the caller graph for this function: