 LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

◆ cungtr()

 subroutine cungtr ( character UPLO, integer N, complex, dimension( lda, * ) A, integer LDA, complex, dimension( * ) TAU, complex, dimension( * ) WORK, integer LWORK, integer INFO )

CUNGTR

Purpose:
CUNGTR generates a complex unitary matrix Q which is defined as the
product of n-1 elementary reflectors of order N, as returned by
CHETRD:

if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),

if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
Parameters
 [in] UPLO UPLO is CHARACTER*1 = 'U': Upper triangle of A contains elementary reflectors from CHETRD; = 'L': Lower triangle of A contains elementary reflectors from CHETRD. [in] N N is INTEGER The order of the matrix Q. N >= 0. [in,out] A A is COMPLEX array, dimension (LDA,N) On entry, the vectors which define the elementary reflectors, as returned by CHETRD. On exit, the N-by-N unitary matrix Q. [in] LDA LDA is INTEGER The leading dimension of the array A. LDA >= N. [in] TAU TAU is COMPLEX array, dimension (N-1) TAU(i) must contain the scalar factor of the elementary reflector H(i), as returned by CHETRD. [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 >= N-1. For optimum performance LWORK >= (N-1)*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 had an illegal value

Definition at line 122 of file cungtr.f.

123 *
124 * -- LAPACK computational routine --
125 * -- LAPACK is a software package provided by Univ. of Tennessee, --
126 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127 *
128 * .. Scalar Arguments ..
129  CHARACTER UPLO
130  INTEGER INFO, LDA, LWORK, N
131 * ..
132 * .. Array Arguments ..
133  COMPLEX A( LDA, * ), TAU( * ), WORK( * )
134 * ..
135 *
136 * =====================================================================
137 *
138 * .. Parameters ..
139  COMPLEX ZERO, ONE
140  parameter( zero = ( 0.0e+0, 0.0e+0 ),
141  \$ one = ( 1.0e+0, 0.0e+0 ) )
142 * ..
143 * .. Local Scalars ..
144  LOGICAL LQUERY, UPPER
145  INTEGER I, IINFO, J, LWKOPT, NB
146 * ..
147 * .. External Functions ..
148  LOGICAL LSAME
149  INTEGER ILAENV
150  EXTERNAL ilaenv, lsame
151 * ..
152 * .. External Subroutines ..
153  EXTERNAL cungql, cungqr, xerbla
154 * ..
155 * .. Intrinsic Functions ..
156  INTRINSIC max
157 * ..
158 * .. Executable Statements ..
159 *
160 * Test the input arguments
161 *
162  info = 0
163  lquery = ( lwork.EQ.-1 )
164  upper = lsame( uplo, 'U' )
165  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
166  info = -1
167  ELSE IF( n.LT.0 ) THEN
168  info = -2
169  ELSE IF( lda.LT.max( 1, n ) ) THEN
170  info = -4
171  ELSE IF( lwork.LT.max( 1, n-1 ) .AND. .NOT.lquery ) THEN
172  info = -7
173  END IF
174 *
175  IF( info.EQ.0 ) THEN
176  IF ( upper ) THEN
177  nb = ilaenv( 1, 'CUNGQL', ' ', n-1, n-1, n-1, -1 )
178  ELSE
179  nb = ilaenv( 1, 'CUNGQR', ' ', n-1, n-1, n-1, -1 )
180  END IF
181  lwkopt = max( 1, n-1 )*nb
182  work( 1 ) = lwkopt
183  END IF
184 *
185  IF( info.NE.0 ) THEN
186  CALL xerbla( 'CUNGTR', -info )
187  RETURN
188  ELSE IF( lquery ) THEN
189  RETURN
190  END IF
191 *
192 * Quick return if possible
193 *
194  IF( n.EQ.0 ) THEN
195  work( 1 ) = 1
196  RETURN
197  END IF
198 *
199  IF( upper ) THEN
200 *
201 * Q was determined by a call to CHETRD with UPLO = 'U'
202 *
203 * Shift the vectors which define the elementary reflectors one
204 * column to the left, and set the last row and column of Q to
205 * those of the unit matrix
206 *
207  DO 20 j = 1, n - 1
208  DO 10 i = 1, j - 1
209  a( i, j ) = a( i, j+1 )
210  10 CONTINUE
211  a( n, j ) = zero
212  20 CONTINUE
213  DO 30 i = 1, n - 1
214  a( i, n ) = zero
215  30 CONTINUE
216  a( n, n ) = one
217 *
218 * Generate Q(1:n-1,1:n-1)
219 *
220  CALL cungql( n-1, n-1, n-1, a, lda, tau, work, lwork, iinfo )
221 *
222  ELSE
223 *
224 * Q was determined by a call to CHETRD with UPLO = 'L'.
225 *
226 * Shift the vectors which define the elementary reflectors one
227 * column to the right, and set the first row and column of Q to
228 * those of the unit matrix
229 *
230  DO 50 j = n, 2, -1
231  a( 1, j ) = zero
232  DO 40 i = j + 1, n
233  a( i, j ) = a( i, j-1 )
234  40 CONTINUE
235  50 CONTINUE
236  a( 1, 1 ) = one
237  DO 60 i = 2, n
238  a( i, 1 ) = zero
239  60 CONTINUE
240  IF( n.GT.1 ) THEN
241 *
242 * Generate Q(2:n,2:n)
243 *
244  CALL cungqr( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
245  \$ lwork, iinfo )
246  END IF
247  END IF
248  work( 1 ) = lwkopt
249  RETURN
250 *
251 * End of CUNGTR
252 *
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine cungql(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQL
Definition: cungql.f:128
subroutine cungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
CUNGQR
Definition: cungqr.f:128
Here is the call graph for this function:
Here is the caller graph for this function: