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