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