LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Date
November 2015

Definition at line 170 of file sormrq.f.

170 *
171 * -- LAPACK computational routine (version 3.6.0) --
172 * -- LAPACK is a software package provided by Univ. of Tennessee, --
173 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174 * November 2015
175 *
176 * .. Scalar Arguments ..
177  CHARACTER side, trans
178  INTEGER info, k, lda, ldc, lwork, m, n
179 * ..
180 * .. Array Arguments ..
181  REAL a( lda, * ), c( ldc, * ), tau( * ),
182  $ work( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  INTEGER nbmax, ldt, tsize
189  parameter ( nbmax = 64, ldt = nbmax+1,
190  $ tsize = ldt*nbmax )
191 * ..
192 * .. Local Scalars ..
193  LOGICAL left, lquery, notran
194  CHARACTER transt
195  INTEGER i, i1, i2, i3, ib, iinfo, iwt, ldwork, lwkopt,
196  $ mi, nb, nbmin, ni, nq, nw
197 * ..
198 * .. External Functions ..
199  LOGICAL lsame
200  INTEGER ilaenv
201  EXTERNAL lsame, ilaenv
202 * ..
203 * .. External Subroutines ..
204  EXTERNAL slarfb, slarft, sormr2, xerbla
205 * ..
206 * .. Intrinsic Functions ..
207  INTRINSIC max, min
208 * ..
209 * .. Executable Statements ..
210 *
211 * Test the input arguments
212 *
213  info = 0
214  left = lsame( side, 'L' )
215  notran = lsame( trans, 'N' )
216  lquery = ( lwork.EQ.-1 )
217 *
218 * NQ is the order of Q and NW is the minimum dimension of WORK
219 *
220  IF( left ) THEN
221  nq = m
222  nw = max( 1, n )
223  ELSE
224  nq = n
225  nw = max( 1, m )
226  END IF
227  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
228  info = -1
229  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
230  info = -2
231  ELSE IF( m.LT.0 ) THEN
232  info = -3
233  ELSE IF( n.LT.0 ) THEN
234  info = -4
235  ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
236  info = -5
237  ELSE IF( lda.LT.max( 1, k ) ) THEN
238  info = -7
239  ELSE IF( ldc.LT.max( 1, m ) ) THEN
240  info = -10
241  ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
242  info = -12
243  END IF
244 *
245  IF( info.EQ.0 ) THEN
246 *
247 * Compute the workspace requirements
248 *
249  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
250  lwkopt = 1
251  ELSE
252  nb = min( nbmax, ilaenv( 1, 'SORMRQ', side // trans, m, n,
253  $ k, -1 ) )
254  lwkopt = nw*nb + tsize
255  END IF
256  work( 1 ) = lwkopt
257  END IF
258 *
259  IF( info.NE.0 ) THEN
260  CALL xerbla( 'SORMRQ', -info )
261  RETURN
262  ELSE IF( lquery ) THEN
263  RETURN
264  END IF
265 *
266 * Quick return if possible
267 *
268  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
269  RETURN
270  END IF
271 *
272  nbmin = 2
273  ldwork = nw
274  IF( nb.GT.1 .AND. nb.LT.k ) THEN
275  IF( lwork.LT.nw*nb+tsize ) THEN
276  nb = (lwork-tsize) / ldwork
277  nbmin = max( 2, ilaenv( 2, 'SORMRQ', side // trans, m, n, k,
278  $ -1 ) )
279  END IF
280  END IF
281 *
282  IF( nb.LT.nbmin .OR. nb.GE.k ) THEN
283 *
284 * Use unblocked code
285 *
286  CALL sormr2( side, trans, m, n, k, a, lda, tau, c, ldc, work,
287  $ iinfo )
288  ELSE
289 *
290 * Use blocked code
291 *
292  iwt = 1 + nw*nb
293  IF( ( left .AND. .NOT.notran ) .OR.
294  $ ( .NOT.left .AND. notran ) ) THEN
295  i1 = 1
296  i2 = k
297  i3 = nb
298  ELSE
299  i1 = ( ( k-1 ) / nb )*nb + 1
300  i2 = 1
301  i3 = -nb
302  END IF
303 *
304  IF( left ) THEN
305  ni = n
306  ELSE
307  mi = m
308  END IF
309 *
310  IF( notran ) THEN
311  transt = 'T'
312  ELSE
313  transt = 'N'
314  END IF
315 *
316  DO 10 i = i1, i2, i3
317  ib = min( nb, k-i+1 )
318 *
319 * Form the triangular factor of the block reflector
320 * H = H(i+ib-1) . . . H(i+1) H(i)
321 *
322  CALL slarft( 'Backward', 'Rowwise', nq-k+i+ib-1, ib,
323  $ a( i, 1 ), lda, tau( i ), work( iwt ), ldt )
324  IF( left ) THEN
325 *
326 * H or H**T is applied to C(1:m-k+i+ib-1,1:n)
327 *
328  mi = m - k + i + ib - 1
329  ELSE
330 *
331 * H or H**T is applied to C(1:m,1:n-k+i+ib-1)
332 *
333  ni = n - k + i + ib - 1
334  END IF
335 *
336 * Apply H or H**T
337 *
338  CALL slarfb( side, transt, 'Backward', 'Rowwise', mi, ni,
339  $ ib, a( i, 1 ), lda, work( iwt ), ldt, c, ldc,
340  $ work, ldwork )
341  10 CONTINUE
342  END IF
343  work( 1 ) = lwkopt
344  RETURN
345 *
346 * End of SORMRQ
347 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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:165
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
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
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:161

Here is the call graph for this function:

Here is the caller graph for this function: