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