LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ sorglq()

subroutine sorglq ( integer  M,
integer  N,
integer  K,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

SORGLQ

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

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

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

 as returned by SGELQF.
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. N >= M.
[in]K
          K is INTEGER
          The number of elementary reflectors whose product defines the
          matrix Q. M >= K >= 0.
[in,out]A
          A is REAL array, dimension (LDA,N)
          On entry, the i-th row must contain the vector which defines
          the elementary reflector H(i), for i = 1,2,...,k, as returned
          by SGELQF in the first k rows 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 SGELQF.
[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,M).
          For optimum performance LWORK >= M*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 126 of file sorglq.f.

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  REAL A( LDA, * ), TAU( * ), WORK( * )
137 * ..
138 *
139 * =====================================================================
140 *
141 * .. Parameters ..
142  REAL ZERO
143  parameter( zero = 0.0e+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 slarfb, slarft, sorgl2, 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, 'SORGLQ', ' ', 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( 'SORGLQ', -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, 'SORGLQ', ' ', 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, 'SORGLQ', ' ', 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 sorgl2( 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 slarft( '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 slarfb( '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 sorgl2( 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 SORGLQ
285 *
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
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
subroutine sorgl2(M, N, K, A, LDA, TAU, WORK, INFO)
SORGL2
Definition: sorgl2.f:113
Here is the call graph for this function:
Here is the caller graph for this function: