LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Date
November 2011

Definition at line 130 of file sorgqr.f.

130 *
131 * -- LAPACK computational routine (version 3.4.0) --
132 * -- LAPACK is a software package provided by Univ. of Tennessee, --
133 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134 * November 2011
135 *
136 * .. Scalar Arguments ..
137  INTEGER info, k, lda, lwork, m, n
138 * ..
139 * .. Array Arguments ..
140  REAL a( lda, * ), tau( * ), work( * )
141 * ..
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146  REAL zero
147  parameter ( zero = 0.0e+0 )
148 * ..
149 * .. Local Scalars ..
150  LOGICAL lquery
151  INTEGER i, ib, iinfo, iws, j, ki, kk, l, ldwork,
152  $ lwkopt, nb, nbmin, nx
153 * ..
154 * .. External Subroutines ..
155  EXTERNAL slarfb, slarft, sorg2r, xerbla
156 * ..
157 * .. Intrinsic Functions ..
158  INTRINSIC max, min
159 * ..
160 * .. External Functions ..
161  INTEGER ilaenv
162  EXTERNAL ilaenv
163 * ..
164 * .. Executable Statements ..
165 *
166 * Test the input arguments
167 *
168  info = 0
169  nb = ilaenv( 1, 'SORGQR', ' ', m, n, k, -1 )
170  lwkopt = max( 1, n )*nb
171  work( 1 ) = lwkopt
172  lquery = ( lwork.EQ.-1 )
173  IF( m.LT.0 ) THEN
174  info = -1
175  ELSE IF( n.LT.0 .OR. n.GT.m ) THEN
176  info = -2
177  ELSE IF( k.LT.0 .OR. k.GT.n ) THEN
178  info = -3
179  ELSE IF( lda.LT.max( 1, m ) ) THEN
180  info = -5
181  ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
182  info = -8
183  END IF
184  IF( info.NE.0 ) THEN
185  CALL xerbla( 'SORGQR', -info )
186  RETURN
187  ELSE IF( lquery ) THEN
188  RETURN
189  END IF
190 *
191 * Quick return if possible
192 *
193  IF( n.LE.0 ) THEN
194  work( 1 ) = 1
195  RETURN
196  END IF
197 *
198  nbmin = 2
199  nx = 0
200  iws = n
201  IF( nb.GT.1 .AND. nb.LT.k ) THEN
202 *
203 * Determine when to cross over from blocked to unblocked code.
204 *
205  nx = max( 0, ilaenv( 3, 'SORGQR', ' ', m, n, k, -1 ) )
206  IF( nx.LT.k ) THEN
207 *
208 * Determine if workspace is large enough for blocked code.
209 *
210  ldwork = n
211  iws = ldwork*nb
212  IF( lwork.LT.iws ) THEN
213 *
214 * Not enough workspace to use optimal NB: reduce NB and
215 * determine the minimum value of NB.
216 *
217  nb = lwork / ldwork
218  nbmin = max( 2, ilaenv( 2, 'SORGQR', ' ', m, n, k, -1 ) )
219  END IF
220  END IF
221  END IF
222 *
223  IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
224 *
225 * Use blocked code after the last block.
226 * The first kk columns are handled by the block method.
227 *
228  ki = ( ( k-nx-1 ) / nb )*nb
229  kk = min( k, ki+nb )
230 *
231 * Set A(1:kk,kk+1:n) to zero.
232 *
233  DO 20 j = kk + 1, n
234  DO 10 i = 1, kk
235  a( i, j ) = zero
236  10 CONTINUE
237  20 CONTINUE
238  ELSE
239  kk = 0
240  END IF
241 *
242 * Use unblocked code for the last or only block.
243 *
244  IF( kk.LT.n )
245  $ CALL sorg2r( m-kk, n-kk, k-kk, a( kk+1, kk+1 ), lda,
246  $ tau( kk+1 ), work, iinfo )
247 *
248  IF( kk.GT.0 ) THEN
249 *
250 * Use blocked code
251 *
252  DO 50 i = ki + 1, 1, -nb
253  ib = min( nb, k-i+1 )
254  IF( i+ib.LE.n ) THEN
255 *
256 * Form the triangular factor of the block reflector
257 * H = H(i) H(i+1) . . . H(i+ib-1)
258 *
259  CALL slarft( 'Forward', 'Columnwise', m-i+1, ib,
260  $ a( i, i ), lda, tau( i ), work, ldwork )
261 *
262 * Apply H to A(i:m,i+ib:n) from the left
263 *
264  CALL slarfb( 'Left', 'No transpose', 'Forward',
265  $ 'Columnwise', m-i+1, n-i-ib+1, ib,
266  $ a( i, i ), lda, work, ldwork, a( i, i+ib ),
267  $ lda, work( ib+1 ), ldwork )
268  END IF
269 *
270 * Apply H to rows i:m of current block
271 *
272  CALL sorg2r( m-i+1, ib, ib, a( i, i ), lda, tau( i ), work,
273  $ iinfo )
274 *
275 * Set rows 1:i-1 of current block to zero
276 *
277  DO 40 j = i, i + ib - 1
278  DO 30 l = 1, i - 1
279  a( l, j ) = zero
280  30 CONTINUE
281  40 CONTINUE
282  50 CONTINUE
283  END IF
284 *
285  work( 1 ) = iws
286  RETURN
287 *
288 * End of SORGQR
289 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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:165
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:116
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
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83

Here is the call graph for this function:

Here is the caller graph for this function: