LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zungrq ( integer  M,
integer  N,
integer  K,
complex*16, dimension( lda, * )  A,
integer  LDA,
complex*16, dimension( * )  TAU,
complex*16, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

ZUNGRQ

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

Purpose: 
 ZUNGRQ generates an M-by-N complex 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 H(2)**H . . . H(k)**H

 as returned by ZGERQF.
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 COMPLEX*16 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 ZGERQF 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 COMPLEX*16 array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by ZGERQF.
[out]WORK
          WORK is COMPLEX*16 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 130 of file zungrq.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  COMPLEX*16 a( lda, * ), tau( * ), work( * )
141 * ..
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146  COMPLEX*16 zero
147  parameter ( zero = ( 0.0d+0, 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 xerbla, zlarfb, zlarft, zungr2
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, 'ZUNGRQ', ' ', 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( 'ZUNGRQ', -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, 'ZUNGRQ', ' ', 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, 'ZUNGRQ', ' ', 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 zungr2( 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 zlarft( 'Backward', 'Rowwise', n-k+i+ib-1, ib,
267  $ a( ii, 1 ), lda, tau( i ), work, ldwork )
268 *
269 * Apply H**H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
270 *
271  CALL zlarfb( 'Right', 'Conjugate transpose', 'Backward',
272  $ 'Rowwise', ii-1, n-k+i+ib-1, ib, a( ii, 1 ),
273  $ lda, work, ldwork, a, lda, work( ib+1 ),
274  $ ldwork )
275  END IF
276 *
277 * Apply H**H to columns 1:n-k+i+ib-1 of current block
278 *
279  CALL zungr2( ib, n-k+i+ib-1, ib, a( ii, 1 ), lda, tau( i ),
280  $ work, iinfo )
281 *
282 * Set columns n-k+i+ib:n of current block to zero
283 *
284  DO 40 l = n - k + i + ib, n
285  DO 30 j = ii, ii + ib - 1
286  a( j, l ) = zero
287  30 CONTINUE
288  40 CONTINUE
289  50 CONTINUE
290  END IF
291 *
292  work( 1 ) = iws
293  RETURN
294 *
295 * End of ZUNGRQ
296 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
zlarfb
subroutine zlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...
Definition: zlarfb.f:197
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
zungr2
subroutine zungr2(M, N, K, A, LDA, TAU, WORK, INFO)
ZUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (u...
Definition: zungr2.f:116
zlarft
subroutine zlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition: zlarft.f:165

Here is the call graph for this function:

Here is the caller graph for this function: