 LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ 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: