LAPACK  3.8.0 LAPACK: Linear Algebra PACKage
sgemqr.f
Go to the documentation of this file.
1 *
2 * Definition:
3 * ===========
4 *
5 * SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
6 * \$ TSIZE, C, LDC, WORK, LWORK, INFO )
7 *
8 *
9 * .. Scalar Arguments ..
10 * CHARACTER SIDE, TRANS
11 * INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
12 * ..
13 * .. Array Arguments ..
14 * REAL A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
15 * ..
16 *
17 *> \par Purpose:
18 * =============
19 *>
20 *> \verbatim
21 *>
22 *> SGEMQR overwrites the general real M-by-N matrix C with
23 *>
24 *> SIDE = 'L' SIDE = 'R'
25 *> TRANS = 'N': Q * C C * Q
26 *> TRANS = 'T': Q**T * C C * Q**T
27 *>
28 *> where Q is a real orthogonal matrix defined as the product
29 *> of blocked elementary reflectors computed by tall skinny
30 *> QR factorization (SGEQR)
31 *>
32 *> \endverbatim
33 *
34 * Arguments:
35 * ==========
36 *
37 *> \param[in] SIDE
38 *> \verbatim
39 *> SIDE is CHARACTER*1
40 *> = 'L': apply Q or Q**T from the Left;
41 *> = 'R': apply Q or Q**T from the Right.
42 *> \endverbatim
43 *>
44 *> \param[in] TRANS
45 *> \verbatim
46 *> TRANS is CHARACTER*1
47 *> = 'N': No transpose, apply Q;
48 *> = 'T': Transpose, apply Q**T.
49 *> \endverbatim
50 *>
51 *> \param[in] M
52 *> \verbatim
53 *> M is INTEGER
54 *> The number of rows of the matrix A. M >=0.
55 *> \endverbatim
56 *>
57 *> \param[in] N
58 *> \verbatim
59 *> N is INTEGER
60 *> The number of columns of the matrix C. N >= 0.
61 *> \endverbatim
62 *>
63 *> \param[in] K
64 *> \verbatim
65 *> K is INTEGER
66 *> The number of elementary reflectors whose product defines
67 *> the matrix Q.
68 *> If SIDE = 'L', M >= K >= 0;
69 *> if SIDE = 'R', N >= K >= 0.
70 *> \endverbatim
71 *>
72 *> \param[in] A
73 *> \verbatim
74 *> A is REAL array, dimension (LDA,K)
75 *> Part of the data structure to represent Q as returned by SGEQR.
76 *> \endverbatim
77 *>
78 *> \param[in] LDA
79 *> \verbatim
80 *> LDA is INTEGER
81 *> The leading dimension of the array A.
82 *> If SIDE = 'L', LDA >= max(1,M);
83 *> if SIDE = 'R', LDA >= max(1,N).
84 *> \endverbatim
85 *>
86 *> \param[in] T
87 *> \verbatim
88 *> T is REAL array, dimension (MAX(5,TSIZE)).
89 *> Part of the data structure to represent Q as returned by SGEQR.
90 *> \endverbatim
91 *>
92 *> \param[in] TSIZE
93 *> \verbatim
94 *> TSIZE is INTEGER
95 *> The dimension of the array T. TSIZE >= 5.
96 *> \endverbatim
97 *>
98 *> \param[in,out] C
99 *> \verbatim
100 *> C is REAL array, dimension (LDC,N)
101 *> On entry, the M-by-N matrix C.
102 *> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
103 *> \endverbatim
104 *>
105 *> \param[in] LDC
106 *> \verbatim
107 *> LDC is INTEGER
108 *> The leading dimension of the array C. LDC >= max(1,M).
109 *> \endverbatim
110 *>
111 *> \param[out] WORK
112 *> \verbatim
113 *> (workspace) REAL array, dimension (MAX(1,LWORK))
114 *> \endverbatim
115 *>
116 *> \param[in] LWORK
117 *> \verbatim
118 *> LWORK is INTEGER
119 *> The dimension of the array WORK.
120 *> If LWORK = -1, then a workspace query is assumed. The routine
121 *> only calculates the size of the WORK array, returns this
122 *> value as WORK(1), and no error message related to WORK
123 *> is issued by XERBLA.
124 *> \endverbatim
125 *>
126 *> \param[out] INFO
127 *> \verbatim
128 *> INFO is INTEGER
129 *> = 0: successful exit
130 *> < 0: if INFO = -i, the i-th argument had an illegal value
131 *> \endverbatim
132 *
133 * Authors:
134 * ========
135 *
136 *> \author Univ. of Tennessee
137 *> \author Univ. of California Berkeley
138 *> \author Univ. of Colorado Denver
139 *> \author NAG Ltd.
140 *
141 *> \par Further Details
142 * ====================
143 *>
144 *> \verbatim
145 *>
146 *> These details are particular for this LAPACK implementation. Users should not
147 *> take them for granted. These details may change in the future, and are unlikely not
148 *> true for another LAPACK implementation. These details are relevant if one wants
149 *> to try to understand the code. They are not part of the interface.
150 *>
151 *> In this version,
152 *>
153 *> T(2): row block size (MB)
154 *> T(3): column block size (NB)
155 *> T(6:TSIZE): data structure needed for Q, computed by
156 *> SLATSQR or SGEQRT
157 *>
158 *> Depending on the matrix dimensions M and N, and row and column
159 *> block sizes MB and NB returned by ILAENV, SGEQR will use either
160 *> SLATSQR (if the matrix is tall-and-skinny) or SGEQRT to compute
161 *> the QR factorization.
162 *> This version of SGEMQR will use either SLAMTSQR or SGEMQRT to
163 *> multiply matrix Q by another matrix.
164 *> Further Details in SLAMTSQR or SGEMQRT.
165 *>
166 *> \endverbatim
167 *>
168 * =====================================================================
169  SUBROUTINE sgemqr( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
170  \$ C, LDC, WORK, LWORK, INFO )
171 *
172 * -- LAPACK computational routine (version 3.7.0) --
173 * -- LAPACK is a software package provided by Univ. of Tennessee, --
174 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
175 * December 2016
176 *
177 * .. Scalar Arguments ..
178  CHARACTER SIDE, TRANS
179  INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
180 * ..
181 * .. Array Arguments ..
182  REAL A( lda, * ), T( * ), C( ldc, * ), WORK( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * ..
188 * .. Local Scalars ..
189  LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
190  INTEGER MB, NB, LW, NBLCKS, MN
191 * ..
192 * .. External Functions ..
193  LOGICAL LSAME
194  EXTERNAL lsame
195 * ..
196 * .. External Subroutines ..
197  EXTERNAL sgemqrt, slamtsqr, xerbla
198 * ..
199 * .. Intrinsic Functions ..
200  INTRINSIC int, max, min, mod
201 * ..
202 * .. Executable Statements ..
203 *
204 * Test the input arguments
205 *
206  lquery = lwork.EQ.-1
207  notran = lsame( trans, 'N' )
208  tran = lsame( trans, 'T' )
209  left = lsame( side, 'L' )
210  right = lsame( side, 'R' )
211 *
212  mb = int( t( 2 ) )
213  nb = int( t( 3 ) )
214  IF( left ) THEN
215  lw = n * nb
216  mn = m
217  ELSE
218  lw = mb * nb
219  mn = n
220  END IF
221 *
222  IF( ( mb.GT.k ) .AND. ( mn.GT.k ) ) THEN
223  IF( mod( mn - k, mb - k ).EQ.0 ) THEN
224  nblcks = ( mn - k ) / ( mb - k )
225  ELSE
226  nblcks = ( mn - k ) / ( mb - k ) + 1
227  END IF
228  ELSE
229  nblcks = 1
230  END IF
231 *
232  info = 0
233  IF( .NOT.left .AND. .NOT.right ) THEN
234  info = -1
235  ELSE IF( .NOT.tran .AND. .NOT.notran ) THEN
236  info = -2
237  ELSE IF( m.LT.0 ) THEN
238  info = -3
239  ELSE IF( n.LT.0 ) THEN
240  info = -4
241  ELSE IF( k.LT.0 .OR. k.GT.mn ) THEN
242  info = -5
243  ELSE IF( lda.LT.max( 1, mn ) ) THEN
244  info = -7
245  ELSE IF( tsize.LT.5 ) THEN
246  info = -9
247  ELSE IF( ldc.LT.max( 1, m ) ) THEN
248  info = -11
249  ELSE IF( ( lwork.LT.max( 1, lw ) ) .AND. ( .NOT.lquery ) ) THEN
250  info = -13
251  END IF
252 *
253  IF( info.EQ.0 ) THEN
254  work( 1 ) = lw
255  END IF
256 *
257  IF( info.NE.0 ) THEN
258  CALL xerbla( 'SGEMQR', -info )
259  RETURN
260  ELSE IF( lquery ) THEN
261  RETURN
262  END IF
263 *
264 * Quick return if possible
265 *
266  IF( min( m, n, k ).EQ.0 ) THEN
267  RETURN
268  END IF
269 *
270  IF( ( left .AND. m.LE.k ) .OR. ( right .AND. n.LE.k )
271  \$ .OR. ( mb.LE.k ) .OR. ( mb.GE.max( m, n, k ) ) ) THEN
272  CALL sgemqrt( side, trans, m, n, k, nb, a, lda, t( 6 ),
273  \$ nb, c, ldc, work, info )
274  ELSE
275  CALL slamtsqr( side, trans, m, n, k, mb, nb, a, lda, t( 6 ),
276  \$ nb, c, ldc, work, lwork, info )
277  END IF
278 *
279  work( 1 ) = lw
280 *
281  RETURN
282 *
283 * End of SGEMQR
284 *
285  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slamtsqr(SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, LDT, C, LDC, WORK, LWORK, INFO)
Definition: slamtsqr.f:197
subroutine sgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
Definition: sgemqr.f:171
subroutine sgemqrt(SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, C, LDC, WORK, INFO)
SGEMQRT
Definition: sgemqrt.f:170