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

◆ sgemqr()

subroutine sgemqr ( character  side,
character  trans,
integer  m,
integer  n,
integer  k,
real, dimension( lda, * )  a,
integer  lda,
real, dimension( * )  t,
integer  tsize,
real, dimension( ldc, * )  c,
integer  ldc,
real, dimension( * )  work,
integer  lwork,
integer  info 
)

SGEMQR

Purpose:
 SGEMQR 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 blocked elementary reflectors computed by tall skinny
 QR factorization (SGEQR)
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 A.  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)
          Part of the data structure to represent Q as returned by SGEQR.
[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]T
          T is REAL array, dimension (MAX(5,TSIZE)).
          Part of the data structure to represent Q as returned by SGEQR.
[in]TSIZE
          TSIZE is INTEGER
          The dimension of the array T. TSIZE >= 5.
[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
         (workspace) REAL array, dimension (MAX(1,LWORK))
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If LWORK = -1, then a workspace query is assumed. The routine
          only calculates the size of the WORK array, returns this
          value as WORK(1), and no error message related to WORK
          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.
Further Details
 These details are particular for this LAPACK implementation. Users should not
 take them for granted. These details may change in the future, and are not likely
 true for another LAPACK implementation. These details are relevant if one wants
 to try to understand the code. They are not part of the interface.

 In this version,

          T(2): row block size (MB)
          T(3): column block size (NB)
          T(6:TSIZE): data structure needed for Q, computed by
                           SLATSQR or SGEQRT

  Depending on the matrix dimensions M and N, and row and column
  block sizes MB and NB returned by ILAENV, SGEQR will use either
  SLATSQR (if the matrix is tall-and-skinny) or SGEQRT to compute
  the QR factorization.
  This version of SGEMQR will use either SLAMTSQR or SGEMQRT to
  multiply matrix Q by another matrix.
  Further Details in SLAMTSQR or SGEMQRT.

Definition at line 172 of file sgemqr.f.

174*
175* -- LAPACK computational routine --
176* -- LAPACK is a software package provided by Univ. of Tennessee, --
177* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178*
179* .. Scalar Arguments ..
180 CHARACTER SIDE, TRANS
181 INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
182* ..
183* .. Array Arguments ..
184 REAL A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
185* ..
186*
187* =====================================================================
188*
189* ..
190* .. Local Scalars ..
191 LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
192 INTEGER MB, NB, LW, NBLCKS, MN
193* ..
194* .. External Functions ..
195 LOGICAL LSAME
196 REAL SROUNDUP_LWORK
197 EXTERNAL lsame, sroundup_lwork
198* ..
199* .. External Subroutines ..
200 EXTERNAL sgemqrt, slamtsqr, xerbla
201* ..
202* .. Intrinsic Functions ..
203 INTRINSIC int, max, min, mod
204* ..
205* .. Executable Statements ..
206*
207* Test the input arguments
208*
209 lquery = lwork.EQ.-1
210 notran = lsame( trans, 'N' )
211 tran = lsame( trans, 'T' )
212 left = lsame( side, 'L' )
213 right = lsame( side, 'R' )
214*
215 mb = int( t( 2 ) )
216 nb = int( t( 3 ) )
217 IF( left ) THEN
218 lw = n * nb
219 mn = m
220 ELSE
221 lw = mb * nb
222 mn = n
223 END IF
224*
225 IF( ( mb.GT.k ) .AND. ( mn.GT.k ) ) THEN
226 IF( mod( mn - k, mb - k ).EQ.0 ) THEN
227 nblcks = ( mn - k ) / ( mb - k )
228 ELSE
229 nblcks = ( mn - k ) / ( mb - k ) + 1
230 END IF
231 ELSE
232 nblcks = 1
233 END IF
234*
235 info = 0
236 IF( .NOT.left .AND. .NOT.right ) THEN
237 info = -1
238 ELSE IF( .NOT.tran .AND. .NOT.notran ) THEN
239 info = -2
240 ELSE IF( m.LT.0 ) THEN
241 info = -3
242 ELSE IF( n.LT.0 ) THEN
243 info = -4
244 ELSE IF( k.LT.0 .OR. k.GT.mn ) THEN
245 info = -5
246 ELSE IF( lda.LT.max( 1, mn ) ) THEN
247 info = -7
248 ELSE IF( tsize.LT.5 ) THEN
249 info = -9
250 ELSE IF( ldc.LT.max( 1, m ) ) THEN
251 info = -11
252 ELSE IF( ( lwork.LT.max( 1, lw ) ) .AND. ( .NOT.lquery ) ) THEN
253 info = -13
254 END IF
255*
256 IF( info.EQ.0 ) THEN
257 work( 1 ) = sroundup_lwork(lw)
258 END IF
259*
260 IF( info.NE.0 ) THEN
261 CALL xerbla( 'SGEMQR', -info )
262 RETURN
263 ELSE IF( lquery ) THEN
264 RETURN
265 END IF
266*
267* Quick return if possible
268*
269 IF( min( m, n, k ).EQ.0 ) THEN
270 RETURN
271 END IF
272*
273 IF( ( left .AND. m.LE.k ) .OR. ( right .AND. n.LE.k )
274 $ .OR. ( mb.LE.k ) .OR. ( mb.GE.max( m, n, k ) ) ) THEN
275 CALL sgemqrt( side, trans, m, n, k, nb, a, lda, t( 6 ),
276 $ nb, c, ldc, work, info )
277 ELSE
278 CALL slamtsqr( side, trans, m, n, k, mb, nb, a, lda, t( 6 ),
279 $ nb, c, ldc, work, lwork, info )
280 END IF
281*
282 work( 1 ) = sroundup_lwork(lw)
283*
284 RETURN
285*
286* End of SGEMQR
287*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgemqrt(side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work, info)
SGEMQRT
Definition sgemqrt.f:168
subroutine slamtsqr(side, trans, m, n, k, mb, nb, a, lda, t, ldt, c, ldc, work, lwork, info)
SLAMTSQR
Definition slamtsqr.f:199
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
Here is the call graph for this function:
Here is the caller graph for this function: