LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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  EXTERNAL lsame, ilaenv
198 * ..
199 * .. External Subroutines ..
200  EXTERNAL slarfb, slarft, sorm2l, xerbla
201 * ..
202 * .. Intrinsic Functions ..
203  INTRINSIC max, min
204 * ..
205 * .. Executable Statements ..
206 *
207 * Test the input arguments
208 *
209  info = 0
210  left = lsame( side, 'L' )
211  notran = lsame( trans, 'N' )
212  lquery = ( lwork.EQ.-1 )
213 *
214 * NQ is the order of Q and NW is the minimum dimension of WORK
215 *
216  IF( left ) THEN
217  nq = m
218  nw = max( 1, n )
219  ELSE
220  nq = n
221  nw = max( 1, m )
222  END IF
223  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
224  info = -1
225  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
226  info = -2
227  ELSE IF( m.LT.0 ) THEN
228  info = -3
229  ELSE IF( n.LT.0 ) THEN
230  info = -4
231  ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
232  info = -5
233  ELSE IF( lda.LT.max( 1, nq ) ) THEN
234  info = -7
235  ELSE IF( ldc.LT.max( 1, m ) ) THEN
236  info = -10
237  ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
238  info = -12
239  END IF
240 *
241  IF( info.EQ.0 ) THEN
242 *
243 * Compute the workspace requirements
244 *
245  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
246  lwkopt = 1
247  ELSE
248  nb = min( nbmax, ilaenv( 1, 'SORMQL', side // trans, m, n,
249  $ k, -1 ) )
250  lwkopt = nw*nb + tsize
251  END IF
252  work( 1 ) = lwkopt
253  END IF
254 *
255  IF( info.NE.0 ) THEN
256  CALL xerbla( 'SORMQL', -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 ) THEN
265  RETURN
266  END IF
267 *
268  nbmin = 2
269  ldwork = nw
270  IF( nb.GT.1 .AND. nb.LT.k ) THEN
271  IF( lwork.LT.lwkopt ) THEN
272  nb = (lwork-tsize) / ldwork
273  nbmin = max( 2, ilaenv( 2, 'SORMQL', side // trans, m, n, k,
274  $ -1 ) )
275  END IF
276  END IF
277 *
278  IF( nb.LT.nbmin .OR. nb.GE.k ) THEN
279 *
280 * Use unblocked code
281 *
282  CALL sorm2l( side, trans, m, n, k, a, lda, tau, c, ldc, work,
283  $ iinfo )
284  ELSE
285 *
286 * Use blocked code
287 *
288  iwt = 1 + nw*nb
289  IF( ( left .AND. notran ) .OR.
290  $ ( .NOT.left .AND. .NOT.notran ) ) THEN
291  i1 = 1
292  i2 = k
293  i3 = nb
294  ELSE
295  i1 = ( ( k-1 ) / nb )*nb + 1
296  i2 = 1
297  i3 = -nb
298  END IF
299 *
300  IF( left ) THEN
301  ni = n
302  ELSE
303  mi = m
304  END IF
305 *
306  DO 10 i = i1, i2, i3
307  ib = min( nb, k-i+1 )
308 *
309 * Form the triangular factor of the block reflector
310 * H = H(i+ib-1) . . . H(i+1) H(i)
311 *
312  CALL slarft( 'Backward', 'Columnwise', nq-k+i+ib-1, ib,
313  $ a( 1, i ), lda, tau( i ), work( iwt ), ldt )
314  IF( left ) THEN
315 *
316 * H or H**T is applied to C(1:m-k+i+ib-1,1:n)
317 *
318  mi = m - k + i + ib - 1
319  ELSE
320 *
321 * H or H**T is applied to C(1:m,1:n-k+i+ib-1)
322 *
323  ni = n - k + i + ib - 1
324  END IF
325 *
326 * Apply H or H**T
327 *
328  CALL slarfb( side, trans, 'Backward', 'Columnwise', mi, ni,
329  $ ib, a( 1, i ), lda, work( iwt ), ldt, c, ldc,
330  $ work, ldwork )
331  10 CONTINUE
332  END IF
333  work( 1 ) = lwkopt
334  RETURN
335 *
336 * End of SORMQL
337 *
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
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
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
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: