LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dorglq ( 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 
)

DORGLQ

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

Purpose: 
 DORGLQ 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 DGELQF.
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 DOUBLE PRECISION 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 DGELQF 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 DOUBLE PRECISION array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by DGELQF.
[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,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.
Date
November 2011

Definition at line 129 of file dorglq.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: