LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zungtr.f
Go to the documentation of this file.
1*> \brief \b ZUNGTR
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZUNGTR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungtr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungtr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungtr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER INFO, LDA, LWORK, N
26* ..
27* .. Array Arguments ..
28* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> ZUNGTR generates a complex unitary matrix Q which is defined as the
38*> product of n-1 elementary reflectors of order N, as returned by
39*> ZHETRD:
40*>
41*> if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
42*>
43*> if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
44*> \endverbatim
45*
46* Arguments:
47* ==========
48*
49*> \param[in] UPLO
50*> \verbatim
51*> UPLO is CHARACTER*1
52*> = 'U': Upper triangle of A contains elementary reflectors
53*> from ZHETRD;
54*> = 'L': Lower triangle of A contains elementary reflectors
55*> from ZHETRD.
56*> \endverbatim
57*>
58*> \param[in] N
59*> \verbatim
60*> N is INTEGER
61*> The order of the matrix Q. N >= 0.
62*> \endverbatim
63*>
64*> \param[in,out] A
65*> \verbatim
66*> A is COMPLEX*16 array, dimension (LDA,N)
67*> On entry, the vectors which define the elementary reflectors,
68*> as returned by ZHETRD.
69*> On exit, the N-by-N unitary matrix Q.
70*> \endverbatim
71*>
72*> \param[in] LDA
73*> \verbatim
74*> LDA is INTEGER
75*> The leading dimension of the array A. LDA >= N.
76*> \endverbatim
77*>
78*> \param[in] TAU
79*> \verbatim
80*> TAU is COMPLEX*16 array, dimension (N-1)
81*> TAU(i) must contain the scalar factor of the elementary
82*> reflector H(i), as returned by ZHETRD.
83*> \endverbatim
84*>
85*> \param[out] WORK
86*> \verbatim
87*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
88*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
89*> \endverbatim
90*>
91*> \param[in] LWORK
92*> \verbatim
93*> LWORK is INTEGER
94*> The dimension of the array WORK. LWORK >= N-1.
95*> For optimum performance LWORK >= (N-1)*NB, where NB is
96*> the optimal blocksize.
97*>
98*> If LWORK = -1, then a workspace query is assumed; the routine
99*> only calculates the optimal size of the WORK array, returns
100*> this value as the first entry of the WORK array, and no error
101*> message related to LWORK is issued by XERBLA.
102*> \endverbatim
103*>
104*> \param[out] INFO
105*> \verbatim
106*> INFO is INTEGER
107*> = 0: successful exit
108*> < 0: if INFO = -i, the i-th argument had an illegal value
109*> \endverbatim
110*
111* Authors:
112* ========
113*
114*> \author Univ. of Tennessee
115*> \author Univ. of California Berkeley
116*> \author Univ. of Colorado Denver
117*> \author NAG Ltd.
118*
119*> \ingroup ungtr
120*
121* =====================================================================
122 SUBROUTINE zungtr( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
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*16 A( LDA, * ), TAU( * ), WORK( * )
134* ..
135*
136* =====================================================================
137*
138* .. Parameters ..
139 COMPLEX*16 ZERO, ONE
140 parameter( zero = ( 0.0d+0, 0.0d+0 ),
141 $ one = ( 1.0d+0, 0.0d+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 lsame, ilaenv
151* ..
152* .. External Subroutines ..
153 EXTERNAL xerbla, zungql, zungqr
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, 'ZUNGQL', ' ', n-1, n-1, n-1, -1 )
178 ELSE
179 nb = ilaenv( 1, 'ZUNGQR', ' ', 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( 'ZUNGTR', -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 ZHETRD 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 zungql( n-1, n-1, n-1, a, lda, tau, work, lwork, iinfo )
221*
222 ELSE
223*
224* Q was determined by a call to ZHETRD 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 zungqr( 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 ZUNGTR
252*
253 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zungql(m, n, k, a, lda, tau, work, lwork, info)
ZUNGQL
Definition zungql.f:128
subroutine zungqr(m, n, k, a, lda, tau, work, lwork, info)
ZUNGQR
Definition zungqr.f:128
subroutine zungtr(uplo, n, a, lda, tau, work, lwork, info)
ZUNGTR
Definition zungtr.f:123