LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cunglq()

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

CUNGLQ

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

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

 as returned by CGELQF.
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 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 CGELQF 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 COMPLEX array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by CGELQF.
[out]WORK
          WORK is COMPLEX 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 129 of file cunglq.f.

129 *
130 * -- LAPACK computational routine (version 3.7.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 * December 2016
134 *
135 * .. Scalar Arguments ..
136  INTEGER INFO, K, LDA, LWORK, M, N
137 * ..
138 * .. Array Arguments ..
139  COMPLEX A( LDA, * ), TAU( * ), WORK( * )
140 * ..
141 *
142 * =====================================================================
143 *
144 * .. Parameters ..
145  COMPLEX ZERO
146  parameter( zero = ( 0.0e+0, 0.0e+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 clarfb, clarft, cungl2, 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, 'CUNGLQ', ' ', 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( 'CUNGLQ', -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, 'CUNGLQ', ' ', 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, 'CUNGLQ', ' ', 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 cungl2( 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 clarft( 'Forward', 'Rowwise', n-i+1, ib, a( i, i ),
259  $ lda, tau( i ), work, ldwork )
260 *
261 * Apply H**H to A(i+ib:m,i:n) from the right
262 *
263  CALL clarfb( 'Right', 'Conjugate transpose', 'Forward',
264  $ 'Rowwise', m-i-ib+1, n-i+1, ib, a( i, i ),
265  $ lda, work, ldwork, a( i+ib, i ), lda,
266  $ work( ib+1 ), ldwork )
267  END IF
268 *
269 * Apply H**H to columns i:n of current block
270 *
271  CALL cungl2( 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 CUNGLQ
288 *
Here is the call graph for this function:
Here is the caller graph for this function:
cungl2
subroutine cungl2(M, N, K, A, LDA, TAU, WORK, INFO)
CUNGL2 generates all or part of the unitary matrix Q from an LQ factorization determined by cgelqf (u...
Definition: cungl2.f:115
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
clarft
subroutine clarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
CLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition: clarft.f:165
clarfb
subroutine clarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
Definition: clarfb.f:199
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: tstiee.f:83