LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
sgerqf.f
Go to the documentation of this file.
1 *> \brief \b SGERQF
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SGERQF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgerqf.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgerqf.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgerqf.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INFO, LDA, LWORK, M, N
25 * ..
26 * .. Array Arguments ..
27 * REAL A( LDA, * ), TAU( * ), WORK( * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> SGERQF computes an RQ factorization of a real M-by-N matrix A:
37 *> A = R * Q.
38 *> \endverbatim
39 *
40 * Arguments:
41 * ==========
42 *
43 *> \param[in] M
44 *> \verbatim
45 *> M is INTEGER
46 *> The number of rows of the matrix A. M >= 0.
47 *> \endverbatim
48 *>
49 *> \param[in] N
50 *> \verbatim
51 *> N is INTEGER
52 *> The number of columns of the matrix A. N >= 0.
53 *> \endverbatim
54 *>
55 *> \param[in,out] A
56 *> \verbatim
57 *> A is REAL array, dimension (LDA,N)
58 *> On entry, the M-by-N matrix A.
59 *> On exit,
60 *> if m <= n, the upper triangle of the subarray
61 *> A(1:m,n-m+1:n) contains the M-by-M upper triangular matrix R;
62 *> if m >= n, the elements on and above the (m-n)-th subdiagonal
63 *> contain the M-by-N upper trapezoidal matrix R;
64 *> the remaining elements, with the array TAU, represent the
65 *> orthogonal matrix Q as a product of min(m,n) elementary
66 *> reflectors (see Further Details).
67 *> \endverbatim
68 *>
69 *> \param[in] LDA
70 *> \verbatim
71 *> LDA is INTEGER
72 *> The leading dimension of the array A. LDA >= max(1,M).
73 *> \endverbatim
74 *>
75 *> \param[out] TAU
76 *> \verbatim
77 *> TAU is REAL array, dimension (min(M,N))
78 *> The scalar factors of the elementary reflectors (see Further
79 *> Details).
80 *> \endverbatim
81 *>
82 *> \param[out] WORK
83 *> \verbatim
84 *> WORK is REAL array, dimension (MAX(1,LWORK))
85 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
86 *> \endverbatim
87 *>
88 *> \param[in] LWORK
89 *> \verbatim
90 *> LWORK is INTEGER
91 *> The dimension of the array WORK. LWORK >= max(1,M).
92 *> For optimum performance LWORK >= M*NB, where NB is
93 *> the optimal blocksize.
94 *>
95 *> If LWORK = -1, then a workspace query is assumed; the routine
96 *> only calculates the optimal size of the WORK array, returns
97 *> this value as the first entry of the WORK array, and no error
98 *> message related to LWORK is issued by XERBLA.
99 *> \endverbatim
100 *>
101 *> \param[out] INFO
102 *> \verbatim
103 *> INFO is INTEGER
104 *> = 0: successful exit
105 *> < 0: if INFO = -i, the i-th argument had an illegal value
106 *> \endverbatim
107 *
108 * Authors:
109 * ========
110 *
111 *> \author Univ. of Tennessee
112 *> \author Univ. of California Berkeley
113 *> \author Univ. of Colorado Denver
114 *> \author NAG Ltd.
115 *
116 *> \date November 2011
117 *
118 *> \ingroup realGEcomputational
119 *
120 *> \par Further Details:
121 * =====================
122 *>
123 *> \verbatim
124 *>
125 *> The matrix Q is represented as a product of elementary reflectors
126 *>
127 *> Q = H(1) H(2) . . . H(k), where k = min(m,n).
128 *>
129 *> Each H(i) has the form
130 *>
131 *> H(i) = I - tau * v * v**T
132 *>
133 *> where tau is a real scalar, and v is a real vector with
134 *> v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
135 *> A(m-k+i,1:n-k+i-1), and tau in TAU(i).
136 *> \endverbatim
137 *>
138 * =====================================================================
139  SUBROUTINE sgerqf( M, N, A, LDA, TAU, WORK, LWORK, INFO )
140 *
141 * -- LAPACK computational routine (version 3.4.0) --
142 * -- LAPACK is a software package provided by Univ. of Tennessee, --
143 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
144 * November 2011
145 *
146 * .. Scalar Arguments ..
147  INTEGER info, lda, lwork, m, n
148 * ..
149 * .. Array Arguments ..
150  REAL a( lda, * ), tau( * ), work( * )
151 * ..
152 *
153 * =====================================================================
154 *
155 * .. Local Scalars ..
156  LOGICAL lquery
157  INTEGER i, ib, iinfo, iws, k, ki, kk, ldwork, lwkopt,
158  $ mu, nb, nbmin, nu, nx
159 * ..
160 * .. External Subroutines ..
161  EXTERNAL sgerq2, slarfb, slarft, xerbla
162 * ..
163 * .. Intrinsic Functions ..
164  INTRINSIC max, min
165 * ..
166 * .. External Functions ..
167  INTEGER ilaenv
168  EXTERNAL ilaenv
169 * ..
170 * .. Executable Statements ..
171 *
172 * Test the input arguments
173 *
174  info = 0
175  lquery = ( lwork.EQ.-1 )
176  IF( m.LT.0 ) THEN
177  info = -1
178  ELSE IF( n.LT.0 ) THEN
179  info = -2
180  ELSE IF( lda.LT.max( 1, m ) ) THEN
181  info = -4
182  ELSE IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery ) THEN
183  info = -7
184  END IF
185 *
186  IF( info.EQ.0 ) THEN
187  k = min( m, n )
188  IF( k.EQ.0 ) THEN
189  lwkopt = 1
190  ELSE
191  nb = ilaenv( 1, 'SGERQF', ' ', m, n, -1, -1 )
192  lwkopt = m*nb
193  work( 1 ) = lwkopt
194  END IF
195  work( 1 ) = lwkopt
196 *
197  IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery ) THEN
198  info = -7
199  END IF
200  END IF
201 *
202  IF( info.NE.0 ) THEN
203  CALL xerbla( 'SGERQF', -info )
204  RETURN
205  ELSE IF( lquery ) THEN
206  RETURN
207  END IF
208 *
209 * Quick return if possible
210 *
211  IF( k.EQ.0 ) THEN
212  RETURN
213  END IF
214 *
215  nbmin = 2
216  nx = 1
217  iws = m
218  IF( nb.GT.1 .AND. nb.LT.k ) THEN
219 *
220 * Determine when to cross over from blocked to unblocked code.
221 *
222  nx = max( 0, ilaenv( 3, 'SGERQF', ' ', m, n, -1, -1 ) )
223  IF( nx.LT.k ) THEN
224 *
225 * Determine if workspace is large enough for blocked code.
226 *
227  ldwork = m
228  iws = ldwork*nb
229  IF( lwork.LT.iws ) THEN
230 *
231 * Not enough workspace to use optimal NB: reduce NB and
232 * determine the minimum value of NB.
233 *
234  nb = lwork / ldwork
235  nbmin = max( 2, ilaenv( 2, 'SGERQF', ' ', m, n, -1,
236  $ -1 ) )
237  END IF
238  END IF
239  END IF
240 *
241  IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
242 *
243 * Use blocked code initially.
244 * The last kk rows are handled by the block method.
245 *
246  ki = ( ( k-nx-1 ) / nb )*nb
247  kk = min( k, ki+nb )
248 *
249  DO 10 i = k - kk + ki + 1, k - kk + 1, -nb
250  ib = min( k-i+1, nb )
251 *
252 * Compute the RQ factorization of the current block
253 * A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1)
254 *
255  CALL sgerq2( ib, n-k+i+ib-1, a( m-k+i, 1 ), lda, tau( i ),
256  $ work, iinfo )
257  IF( m-k+i.GT.1 ) THEN
258 *
259 * Form the triangular factor of the block reflector
260 * H = H(i+ib-1) . . . H(i+1) H(i)
261 *
262  CALL slarft( 'Backward', 'Rowwise', n-k+i+ib-1, ib,
263  $ a( m-k+i, 1 ), lda, tau( i ), work, ldwork )
264 *
265 * Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
266 *
267  CALL slarfb( 'Right', 'No transpose', 'Backward',
268  $ 'Rowwise', m-k+i-1, n-k+i+ib-1, ib,
269  $ a( m-k+i, 1 ), lda, work, ldwork, a, lda,
270  $ work( ib+1 ), ldwork )
271  END IF
272  10 CONTINUE
273  mu = m - k + i + nb - 1
274  nu = n - k + i + nb - 1
275  ELSE
276  mu = m
277  nu = n
278  END IF
279 *
280 * Use unblocked code to factor the last or only block
281 *
282  IF( mu.GT.0 .AND. nu.GT.0 )
283  $ CALL sgerq2( mu, nu, a, lda, tau, work, iinfo )
284 *
285  work( 1 ) = iws
286  RETURN
287 *
288 * End of SGERQF
289 *
290  END