LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dorgql()

subroutine dorgql ( integer  m,
integer  n,
integer  k,
double precision, dimension( lda, * )  a,
integer  lda,
double precision, dimension( * )  tau,
double precision, dimension( * )  work,
integer  lwork,
integer  info 
)

DORGQL

Download DORGQL + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DORGQL generates an M-by-N real matrix Q with orthonormal columns,
 which is defined as the last N columns of a product of K elementary
 reflectors of order M

       Q  =  H(k) . . . H(2) H(1)

 as returned by DGEQLF.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrix Q. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix Q. M >= N >= 0.
[in]K
          K is INTEGER
          The number of elementary reflectors whose product defines the
          matrix Q. N >= K >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA,N)
          On entry, the (n-k+i)-th column must contain the vector which
          defines the elementary reflector H(i), for i = 1,2,...,k, as
          returned by DGEQLF in the last k columns of its array
          argument A.
          On exit, the M-by-N matrix Q.
[in]LDA
          LDA is INTEGER
          The first dimension of the array A. LDA >= max(1,M).
[in]TAU
          TAU is DOUBLE PRECISION array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by DGEQLF.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK. LWORK >= max(1,N).
          For optimum performance LWORK >= N*NB, where NB is the
          optimal blocksize.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument has an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 127 of file dorgql.f.

128*
129* -- LAPACK computational routine --
130* -- LAPACK is a software package provided by Univ. of Tennessee, --
131* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132*
133* .. Scalar Arguments ..
134 INTEGER INFO, K, LDA, LWORK, M, N
135* ..
136* .. Array Arguments ..
137 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
138* ..
139*
140* =====================================================================
141*
142* .. Parameters ..
143 DOUBLE PRECISION ZERO
144 parameter( zero = 0.0d+0 )
145* ..
146* .. Local Scalars ..
147 LOGICAL LQUERY
148 INTEGER I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
149 $ NB, NBMIN, NX
150* ..
151* .. External Subroutines ..
152 EXTERNAL dlarfb, dlarft, dorg2l, xerbla
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC max, min
156* ..
157* .. External Functions ..
158 INTEGER ILAENV
159 EXTERNAL ilaenv
160* ..
161* .. Executable Statements ..
162*
163* Test the input arguments
164*
165 info = 0
166 lquery = ( lwork.EQ.-1 )
167 IF( m.LT.0 ) THEN
168 info = -1
169 ELSE IF( n.LT.0 .OR. n.GT.m ) THEN
170 info = -2
171 ELSE IF( k.LT.0 .OR. k.GT.n ) THEN
172 info = -3
173 ELSE IF( lda.LT.max( 1, m ) ) THEN
174 info = -5
175 END IF
176*
177 IF( info.EQ.0 ) THEN
178 IF( n.EQ.0 ) THEN
179 lwkopt = 1
180 ELSE
181 nb = ilaenv( 1, 'DORGQL', ' ', m, n, k, -1 )
182 lwkopt = n*nb
183 END IF
184 work( 1 ) = lwkopt
185*
186 IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
187 info = -8
188 END IF
189 END IF
190*
191 IF( info.NE.0 ) THEN
192 CALL xerbla( 'DORGQL', -info )
193 RETURN
194 ELSE IF( lquery ) THEN
195 RETURN
196 END IF
197*
198* Quick return if possible
199*
200 IF( n.LE.0 ) THEN
201 RETURN
202 END IF
203*
204 nbmin = 2
205 nx = 0
206 iws = n
207 IF( nb.GT.1 .AND. nb.LT.k ) THEN
208*
209* Determine when to cross over from blocked to unblocked code.
210*
211 nx = max( 0, ilaenv( 3, 'DORGQL', ' ', m, n, k, -1 ) )
212 IF( nx.LT.k ) THEN
213*
214* Determine if workspace is large enough for blocked code.
215*
216 ldwork = n
217 iws = ldwork*nb
218 IF( lwork.LT.iws ) THEN
219*
220* Not enough workspace to use optimal NB: reduce NB and
221* determine the minimum value of NB.
222*
223 nb = lwork / ldwork
224 nbmin = max( 2, ilaenv( 2, 'DORGQL', ' ', m, n, k, -1 ) )
225 END IF
226 END IF
227 END IF
228*
229 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
230*
231* Use blocked code after the first block.
232* The last kk columns are handled by the block method.
233*
234 kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
235*
236* Set A(m-kk+1:m,1:n-kk) to zero.
237*
238 DO 20 j = 1, n - kk
239 DO 10 i = m - kk + 1, m
240 a( i, j ) = zero
241 10 CONTINUE
242 20 CONTINUE
243 ELSE
244 kk = 0
245 END IF
246*
247* Use unblocked code for the first or only block.
248*
249 CALL dorg2l( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
250*
251 IF( kk.GT.0 ) THEN
252*
253* Use blocked code
254*
255 DO 50 i = k - kk + 1, k, nb
256 ib = min( nb, k-i+1 )
257 IF( n-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 dlarft( 'Backward', 'Columnwise', m-k+i+ib-1, ib,
263 $ a( 1, n-k+i ), lda, tau( i ), work, ldwork )
264*
265* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
266*
267 CALL dlarfb( 'Left', 'No transpose', 'Backward',
268 $ 'Columnwise', m-k+i+ib-1, n-k+i-1, ib,
269 $ a( 1, n-k+i ), lda, work, ldwork, a, lda,
270 $ work( ib+1 ), ldwork )
271 END IF
272*
273* Apply H to rows 1:m-k+i+ib-1 of current block
274*
275 CALL dorg2l( m-k+i+ib-1, ib, ib, a( 1, n-k+i ), lda,
276 $ tau( i ), work, iinfo )
277*
278* Set rows m-k+i+ib:m of current block to zero
279*
280 DO 40 j = n - k + i, n - k + i + ib - 1
281 DO 30 l = m - k + i + ib, m
282 a( l, j ) = zero
283 30 CONTINUE
284 40 CONTINUE
285 50 CONTINUE
286 END IF
287*
288 work( 1 ) = iws
289 RETURN
290*
291* End of DORGQL
292*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
dlarfb
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
dlarft
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
dorg2l
subroutine dorg2l(m, n, k, a, lda, tau, work, info)
DORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf ...
Definition dorg2l.f:114
Here is the call graph for this function:
Here is the caller graph for this function: