LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sgemlqt.f
Go to the documentation of this file.
1*> \brief \b SGEMLQT
2*
3* Definition:
4* ===========
5*
6* SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
7* C, LDC, WORK, INFO )
8*
9* .. Scalar Arguments ..
10* CHARACTER SIDE, TRANS
11* INTEGER INFO, K, LDV, LDC, M, N, MB, LDT
12* ..
13* .. Array Arguments ..
14* REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
15* ..
16*
17*
18*> \par Purpose:
19* =============
20*>
21*> \verbatim
22*>
23*> DGEMLQT overwrites the general real M-by-N matrix C with
24*>
25*> SIDE = 'L' SIDE = 'R'
26*> TRANS = 'N': Q C C Q
27*> TRANS = 'T': Q**T C C Q**T
28*>
29*> where Q is a real orthogonal matrix defined as the product of K
30*> elementary reflectors:
31*>
32*> Q = H(1) H(2) . . . H(K) = I - V T V**T
33*>
34*> generated using the compact WY representation as returned by SGELQT.
35*>
36*> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'.
37*> \endverbatim
38*
39* Arguments:
40* ==========
41*
42*> \param[in] SIDE
43*> \verbatim
44*> SIDE is CHARACTER*1
45*> = 'L': apply Q or Q**T from the Left;
46*> = 'R': apply Q or Q**T from the Right.
47*> \endverbatim
48*>
49*> \param[in] TRANS
50*> \verbatim
51*> TRANS is CHARACTER*1
52*> = 'N': No transpose, apply Q;
53*> = 'C': Transpose, apply Q**T.
54*> \endverbatim
55*>
56*> \param[in] M
57*> \verbatim
58*> M is INTEGER
59*> The number of rows of the matrix C. M >= 0.
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*> N is INTEGER
65*> The number of columns of the matrix C. N >= 0.
66*> \endverbatim
67*>
68*> \param[in] K
69*> \verbatim
70*> K is INTEGER
71*> The number of elementary reflectors whose product defines
72*> the matrix Q.
73*> If SIDE = 'L', M >= K >= 0;
74*> if SIDE = 'R', N >= K >= 0.
75*> \endverbatim
76*>
77*> \param[in] MB
78*> \verbatim
79*> MB is INTEGER
80*> The block size used for the storage of T. K >= MB >= 1.
81*> This must be the same value of MB used to generate T
82*> in SGELQT.
83*> \endverbatim
84*>
85*> \param[in] V
86*> \verbatim
87*> V is REAL array, dimension
88*> (LDV,M) if SIDE = 'L',
89*> (LDV,N) if SIDE = 'R'
90*> The i-th row must contain the vector which defines the
91*> elementary reflector H(i), for i = 1,2,...,k, as returned by
92*> SGELQT in the first K rows of its array argument A.
93*> \endverbatim
94*>
95*> \param[in] LDV
96*> \verbatim
97*> LDV is INTEGER
98*> The leading dimension of the array V. LDV >= max(1,K).
99*> \endverbatim
100*>
101*> \param[in] T
102*> \verbatim
103*> T is REAL array, dimension (LDT,K)
104*> The upper triangular factors of the block reflectors
105*> as returned by SGELQT, stored as a MB-by-K matrix.
106*> \endverbatim
107*>
108*> \param[in] LDT
109*> \verbatim
110*> LDT is INTEGER
111*> The leading dimension of the array T. LDT >= MB.
112*> \endverbatim
113*>
114*> \param[in,out] C
115*> \verbatim
116*> C is REAL array, dimension (LDC,N)
117*> On entry, the M-by-N matrix C.
118*> On exit, C is overwritten by Q C, Q**T C, C Q**T or C Q.
119*> \endverbatim
120*>
121*> \param[in] LDC
122*> \verbatim
123*> LDC is INTEGER
124*> The leading dimension of the array C. LDC >= max(1,M).
125*> \endverbatim
126*>
127*> \param[out] WORK
128*> \verbatim
129*> WORK is REAL array. The dimension of
130*> WORK is N*MB if SIDE = 'L', or M*MB if SIDE = 'R'.
131*> \endverbatim
132*>
133*> \param[out] INFO
134*> \verbatim
135*> INFO is INTEGER
136*> = 0: successful exit
137*> < 0: if INFO = -i, the i-th argument had an illegal value
138*> \endverbatim
139*
140* Authors:
141* ========
142*
143*> \author Univ. of Tennessee
144*> \author Univ. of California Berkeley
145*> \author Univ. of Colorado Denver
146*> \author NAG Ltd.
147*
148*> \ingroup doubleGEcomputational
149*
150* =====================================================================
151 SUBROUTINE sgemlqt( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT,
152 $ C, LDC, WORK, INFO )
153*
154* -- LAPACK computational routine --
155* -- LAPACK is a software package provided by Univ. of Tennessee, --
156* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
157*
158* .. Scalar Arguments ..
159 CHARACTER SIDE, TRANS
160 INTEGER INFO, K, LDV, LDC, M, N, MB, LDT
161* ..
162* .. Array Arguments ..
163 REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
164* ..
165*
166* =====================================================================
167*
168* ..
169* .. Local Scalars ..
170 LOGICAL LEFT, RIGHT, TRAN, NOTRAN
171 INTEGER I, IB, LDWORK, KF, Q
172* ..
173* .. External Functions ..
174 LOGICAL LSAME
175 EXTERNAL lsame
176* ..
177* .. External Subroutines ..
178 EXTERNAL xerbla, slarfb
179* ..
180* .. Intrinsic Functions ..
181 INTRINSIC max, min
182* ..
183* .. Executable Statements ..
184*
185* .. Test the input arguments ..
186*
187 info = 0
188 left = lsame( side, 'L' )
189 right = lsame( side, 'R' )
190 tran = lsame( trans, 'T' )
191 notran = lsame( trans, 'N' )
192*
193 IF( left ) THEN
194 ldwork = max( 1, n )
195 q = m
196 ELSE IF ( right ) THEN
197 ldwork = max( 1, m )
198 q = n
199 END IF
200 IF( .NOT.left .AND. .NOT.right ) THEN
201 info = -1
202 ELSE IF( .NOT.tran .AND. .NOT.notran ) THEN
203 info = -2
204 ELSE IF( m.LT.0 ) THEN
205 info = -3
206 ELSE IF( n.LT.0 ) THEN
207 info = -4
208 ELSE IF( k.LT.0 .OR. k.GT.q ) THEN
209 info = -5
210 ELSE IF( mb.LT.1 .OR. (mb.GT.k .AND. k.GT.0)) THEN
211 info = -6
212 ELSE IF( ldv.LT.max( 1, k ) ) THEN
213 info = -8
214 ELSE IF( ldt.LT.mb ) THEN
215 info = -10
216 ELSE IF( ldc.LT.max( 1, m ) ) THEN
217 info = -12
218 END IF
219*
220 IF( info.NE.0 ) THEN
221 CALL xerbla( 'SGEMLQT', -info )
222 RETURN
223 END IF
224*
225* .. Quick return if possible ..
226*
227 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 ) RETURN
228*
229 IF( left .AND. notran ) THEN
230*
231 DO i = 1, k, mb
232 ib = min( mb, k-i+1 )
233 CALL slarfb( 'L', 'T', 'F', 'R', m-i+1, n, ib,
234 $ v( i, i ), ldv, t( 1, i ), ldt,
235 $ c( i, 1 ), ldc, work, ldwork )
236 END DO
237*
238 ELSE IF( right .AND. tran ) THEN
239*
240 DO i = 1, k, mb
241 ib = min( mb, k-i+1 )
242 CALL slarfb( 'R', 'N', 'F', 'R', m, n-i+1, ib,
243 $ v( i, i ), ldv, t( 1, i ), ldt,
244 $ c( 1, i ), ldc, work, ldwork )
245 END DO
246*
247 ELSE IF( left .AND. tran ) THEN
248*
249 kf = ((k-1)/mb)*mb+1
250 DO i = kf, 1, -mb
251 ib = min( mb, k-i+1 )
252 CALL slarfb( 'L', 'N', 'F', 'R', m-i+1, n, ib,
253 $ v( i, i ), ldv, t( 1, i ), ldt,
254 $ c( i, 1 ), ldc, work, ldwork )
255 END DO
256*
257 ELSE IF( right .AND. notran ) THEN
258*
259 kf = ((k-1)/mb)*mb+1
260 DO i = kf, 1, -mb
261 ib = min( mb, k-i+1 )
262 CALL slarfb( 'R', 'T', 'F', 'R', m, n-i+1, ib,
263 $ v( i, i ), ldv, t( 1, i ), ldt,
264 $ c( 1, i ), ldc, work, ldwork )
265 END DO
266*
267 END IF
268*
269 RETURN
270*
271* End of SGEMLQT
272*
273 END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine sgemlqt(SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, C, LDC, WORK, INFO)
SGEMLQT
Definition: sgemlqt.f:153
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