LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ dorgrq()

subroutine dorgrq ( 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 
)

DORGRQ

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

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

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

 as returned by DGERQF.
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 (m-k+i)-th row must contain the vector which
          defines the elementary reflector H(i), for i = 1,2,...,k, as
          returned by DGERQF in the last 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 DGERQF.
[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
December 2016

Definition at line 130 of file dorgrq.f.

130 *
131 * -- LAPACK computational routine (version 3.7.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 * December 2016
135 *
136 * .. Scalar Arguments ..
137  INTEGER INFO, K, LDA, LWORK, M, N
138 * ..
139 * .. Array Arguments ..
140  DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
141 * ..
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146  DOUBLE PRECISION ZERO
147  parameter( zero = 0.0d+0 )
148 * ..
149 * .. Local Scalars ..
150  LOGICAL LQUERY
151  INTEGER I, IB, II, IINFO, IWS, J, KK, L, LDWORK,
152  $ LWKOPT, NB, NBMIN, NX
153 * ..
154 * .. External Subroutines ..
155  EXTERNAL dlarfb, dlarft, dorgr2, 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  lquery = ( lwork.EQ.-1 )
170  IF( m.LT.0 ) THEN
171  info = -1
172  ELSE IF( n.LT.m ) THEN
173  info = -2
174  ELSE IF( k.LT.0 .OR. k.GT.m ) THEN
175  info = -3
176  ELSE IF( lda.LT.max( 1, m ) ) THEN
177  info = -5
178  END IF
179 *
180  IF( info.EQ.0 ) THEN
181  IF( m.LE.0 ) THEN
182  lwkopt = 1
183  ELSE
184  nb = ilaenv( 1, 'DORGRQ', ' ', m, n, k, -1 )
185  lwkopt = m*nb
186  END IF
187  work( 1 ) = lwkopt
188 *
189  IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery ) THEN
190  info = -8
191  END IF
192  END IF
193 *
194  IF( info.NE.0 ) THEN
195  CALL xerbla( 'DORGRQ', -info )
196  RETURN
197  ELSE IF( lquery ) THEN
198  RETURN
199  END IF
200 *
201 * Quick return if possible
202 *
203  IF( m.LE.0 ) THEN
204  RETURN
205  END IF
206 *
207  nbmin = 2
208  nx = 0
209  iws = m
210  IF( nb.GT.1 .AND. nb.LT.k ) THEN
211 *
212 * Determine when to cross over from blocked to unblocked code.
213 *
214  nx = max( 0, ilaenv( 3, 'DORGRQ', ' ', m, n, k, -1 ) )
215  IF( nx.LT.k ) THEN
216 *
217 * Determine if workspace is large enough for blocked code.
218 *
219  ldwork = m
220  iws = ldwork*nb
221  IF( lwork.LT.iws ) THEN
222 *
223 * Not enough workspace to use optimal NB: reduce NB and
224 * determine the minimum value of NB.
225 *
226  nb = lwork / ldwork
227  nbmin = max( 2, ilaenv( 2, 'DORGRQ', ' ', m, n, k, -1 ) )
228  END IF
229  END IF
230  END IF
231 *
232  IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
233 *
234 * Use blocked code after the first block.
235 * The last kk rows are handled by the block method.
236 *
237  kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
238 *
239 * Set A(1:m-kk,n-kk+1:n) to zero.
240 *
241  DO 20 j = n - kk + 1, n
242  DO 10 i = 1, m - kk
243  a( i, j ) = zero
244  10 CONTINUE
245  20 CONTINUE
246  ELSE
247  kk = 0
248  END IF
249 *
250 * Use unblocked code for the first or only block.
251 *
252  CALL dorgr2( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
253 *
254  IF( kk.GT.0 ) THEN
255 *
256 * Use blocked code
257 *
258  DO 50 i = k - kk + 1, k, nb
259  ib = min( nb, k-i+1 )
260  ii = m - k + i
261  IF( ii.GT.1 ) THEN
262 *
263 * Form the triangular factor of the block reflector
264 * H = H(i+ib-1) . . . H(i+1) H(i)
265 *
266  CALL dlarft( 'Backward', 'Rowwise', n-k+i+ib-1, ib,
267  $ a( ii, 1 ), lda, tau( i ), work, ldwork )
268 *
269 * Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
270 *
271  CALL dlarfb( 'Right', 'Transpose', 'Backward', 'Rowwise',
272  $ ii-1, n-k+i+ib-1, ib, a( ii, 1 ), lda, work,
273  $ ldwork, a, lda, work( ib+1 ), ldwork )
274  END IF
275 *
276 * Apply H**T to columns 1:n-k+i+ib-1 of current block
277 *
278  CALL dorgr2( ib, n-k+i+ib-1, ib, a( ii, 1 ), lda, tau( i ),
279  $ work, iinfo )
280 *
281 * Set columns n-k+i+ib:n of current block to zero
282 *
283  DO 40 l = n - k + i + ib, n
284  DO 30 j = ii, ii + ib - 1
285  a( j, l ) = zero
286  30 CONTINUE
287  40 CONTINUE
288  50 CONTINUE
289  END IF
290 *
291  work( 1 ) = iws
292  RETURN
293 *
294 * End of DORGRQ
295 *
Here is the call graph for this function:
Here is the caller graph for this function:
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
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:199
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: tstiee.f:83
dorgr2
subroutine dorgr2(M, N, K, A, LDA, TAU, WORK, INFO)
DORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf...
Definition: dorgr2.f:116