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

Definition at line 170 of file sormlq.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, ic, iinfo, iwt, jc, ldwork,
196  $ lwkopt, 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, sorml2, 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 = n
223  ELSE
224  nq = n
225  nw = 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.max( 1, 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  nb = min( nbmax, ilaenv( 1, 'SORMLQ', side // trans, m, n, k,
250  $ -1 ) )
251  lwkopt = max( 1, nw )*nb + tsize
252  work( 1 ) = lwkopt
253  END IF
254 *
255  IF( info.NE.0 ) THEN
256  CALL xerbla( 'SORMLQ', -info )
257  RETURN
258  ELSE IF( lquery ) THEN
259  RETURN
260  END IF
261 *
262 * Quick return if possible
263 *
264  IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 ) THEN
265  work( 1 ) = 1
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.nw*nb+tsize ) THEN
273  nb = (lwork-tsize) / ldwork
274  nbmin = max( 2, ilaenv( 2, 'SORMLQ', 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 sorml2( 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  jc = 1
304  ELSE
305  mi = m
306  ic = 1
307  END IF
308 *
309  IF( notran ) THEN
310  transt = 'T'
311  ELSE
312  transt = 'N'
313  END IF
314 *
315  DO 10 i = i1, i2, i3
316  ib = min( nb, k-i+1 )
317 *
318 * Form the triangular factor of the block reflector
319 * H = H(i) H(i+1) . . . H(i+ib-1)
320 *
321  CALL slarft( 'Forward', 'Rowwise', nq-i+1, ib, a( i, i ),
322  $ lda, tau( i ), work( iwt ), ldt )
323  IF( left ) THEN
324 *
325 * H or H**T is applied to C(i:m,1:n)
326 *
327  mi = m - i + 1
328  ic = i
329  ELSE
330 *
331 * H or H**T is applied to C(1:m,i:n)
332 *
333  ni = n - i + 1
334  jc = i
335  END IF
336 *
337 * Apply H or H**T
338 *
339  CALL slarfb( side, transt, 'Forward', 'Rowwise', mi, ni, ib,
340  $ a( i, i ), lda, work( iwt ), ldt,
341  $ c( ic, jc ), ldc, work, ldwork )
342  10 CONTINUE
343  END IF
344  work( 1 ) = lwkopt
345  RETURN
346 *
347 * End of SORMLQ
348 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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:165
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
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
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:161
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: