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

◆ sorgqr()

subroutine sorgqr ( integer  m,
integer  n,
integer  k,
real, dimension( lda, * )  a,
integer  lda,
real, dimension( * )  tau,
real, dimension( * )  work,
integer  lwork,
integer  info 
)

SORGQR

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

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

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

 as returned by SGEQRF.
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 REAL array, dimension (LDA,N)
          On entry, the i-th column must contain the vector which
          defines the elementary reflector H(i), for i = 1,2,...,k, as
          returned by SGEQRF in the first 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 REAL array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by SGEQRF.
[out]WORK
          WORK is REAL 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 sorgqr.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 REAL A( LDA, * ), TAU( * ), WORK( * )
138* ..
139*
140* =====================================================================
141*
142* .. Parameters ..
143 REAL ZERO
144 parameter( zero = 0.0e+0 )
145* ..
146* .. Local Scalars ..
147 LOGICAL LQUERY
148 INTEGER I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
149 $ LWKOPT, NB, NBMIN, NX
150* ..
151* .. External Subroutines ..
152 EXTERNAL slarfb, slarft, sorg2r, xerbla
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC max, min
156* ..
157* .. External Functions ..
158 INTEGER ILAENV
159 REAL SROUNDUP_LWORK
160 EXTERNAL ilaenv, sroundup_lwork
161* ..
162* .. Executable Statements ..
163*
164* Test the input arguments
165*
166 info = 0
167 nb = ilaenv( 1, 'SORGQR', ' ', m, n, k, -1 )
168 lwkopt = max( 1, n )*nb
169 work( 1 ) = sroundup_lwork(lwkopt)
170 lquery = ( lwork.EQ.-1 )
171 IF( m.LT.0 ) THEN
172 info = -1
173 ELSE IF( n.LT.0 .OR. n.GT.m ) THEN
174 info = -2
175 ELSE IF( k.LT.0 .OR. k.GT.n ) THEN
176 info = -3
177 ELSE IF( lda.LT.max( 1, m ) ) THEN
178 info = -5
179 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
180 info = -8
181 END IF
182 IF( info.NE.0 ) THEN
183 CALL xerbla( 'SORGQR', -info )
184 RETURN
185 ELSE IF( lquery ) THEN
186 RETURN
187 END IF
188*
189* Quick return if possible
190*
191 IF( n.LE.0 ) THEN
192 work( 1 ) = 1
193 RETURN
194 END IF
195*
196 nbmin = 2
197 nx = 0
198 iws = n
199 IF( nb.GT.1 .AND. nb.LT.k ) THEN
200*
201* Determine when to cross over from blocked to unblocked code.
202*
203 nx = max( 0, ilaenv( 3, 'SORGQR', ' ', m, n, k, -1 ) )
204 IF( nx.LT.k ) THEN
205*
206* Determine if workspace is large enough for blocked code.
207*
208 ldwork = n
209 iws = ldwork*nb
210 IF( lwork.LT.iws ) THEN
211*
212* Not enough workspace to use optimal NB: reduce NB and
213* determine the minimum value of NB.
214*
215 nb = lwork / ldwork
216 nbmin = max( 2, ilaenv( 2, 'SORGQR', ' ', m, n, k, -1 ) )
217 END IF
218 END IF
219 END IF
220*
221 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
222*
223* Use blocked code after the last block.
224* The first kk columns are handled by the block method.
225*
226 ki = ( ( k-nx-1 ) / nb )*nb
227 kk = min( k, ki+nb )
228*
229* Set A(1:kk,kk+1:n) to zero.
230*
231 DO 20 j = kk + 1, n
232 DO 10 i = 1, kk
233 a( i, j ) = zero
234 10 CONTINUE
235 20 CONTINUE
236 ELSE
237 kk = 0
238 END IF
239*
240* Use unblocked code for the last or only block.
241*
242 IF( kk.LT.n )
243 $ CALL sorg2r( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
244 $ tau( kk+1 ), work, iinfo )
245*
246 IF( kk.GT.0 ) THEN
247*
248* Use blocked code
249*
250 DO 50 i = ki + 1, 1, -nb
251 ib = min( nb, k-i+1 )
252 IF( i+ib.LE.n ) THEN
253*
254* Form the triangular factor of the block reflector
255* H = H(i) H(i+1) . . . H(i+ib-1)
256*
257 CALL slarft( 'Forward', 'Columnwise', m-i+1, ib,
258 $ a( i, i ), lda, tau( i ), work, ldwork )
259*
260* Apply H to A(i:m,i+ib:n) from the left
261*
262 CALL slarfb( 'Left', 'No transpose', 'Forward',
263 $ 'Columnwise', m-i+1, n-i-ib+1, ib,
264 $ a( i, i ), lda, work, ldwork, a( i, i+ib ),
265 $ lda, work( ib+1 ), ldwork )
266 END IF
267*
268* Apply H to rows i:m of current block
269*
270 CALL sorg2r( m-i+1, ib, ib, a( i, i ), lda, tau( i ), work,
271 $ iinfo )
272*
273* Set rows 1:i-1 of current block to zero
274*
275 DO 40 j = i, i + ib - 1
276 DO 30 l = 1, i - 1
277 a( l, j ) = zero
278 30 CONTINUE
279 40 CONTINUE
280 50 CONTINUE
281 END IF
282*
283 work( 1 ) = sroundup_lwork(iws)
284 RETURN
285*
286* End of SORGQR
287*
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
slarfb
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
slarft
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
sroundup_lwork
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
Definition sroundup_lwork.f:59
sorg2r
subroutine sorg2r(m, n, k, a, lda, tau, work, info)
SORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf ...
Definition sorg2r.f:114
Here is the call graph for this function:
Here is the caller graph for this function: