LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> \date November 2011
120 *
121 *> \ingroup complex16OTHERcomputational
122 *
123 * =====================================================================
124  SUBROUTINE zungtr( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO )
125 *
126 * -- LAPACK computational routine (version 3.4.0) --
127 * -- LAPACK is a software package provided by Univ. of Tennessee, --
128 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
129 * November 2011
130 *
131 * .. Scalar Arguments ..
132  CHARACTER uplo
133  INTEGER info, lda, lwork, n
134 * ..
135 * .. Array Arguments ..
136  COMPLEX*16 a( lda, * ), tau( * ), work( * )
137 * ..
138 *
139 * =====================================================================
140 *
141 * .. Parameters ..
142  COMPLEX*16 zero, one
143  parameter( zero = ( 0.0d+0, 0.0d+0 ),
144  $ one = ( 1.0d+0, 0.0d+0 ) )
145 * ..
146 * .. Local Scalars ..
147  LOGICAL lquery, upper
148  INTEGER i, iinfo, j, lwkopt, nb
149 * ..
150 * .. External Functions ..
151  LOGICAL lsame
152  INTEGER ilaenv
153  EXTERNAL lsame, ilaenv
154 * ..
155 * .. External Subroutines ..
156  EXTERNAL xerbla, zungql, zungqr
157 * ..
158 * .. Intrinsic Functions ..
159  INTRINSIC max
160 * ..
161 * .. Executable Statements ..
162 *
163 * Test the input arguments
164 *
165  info = 0
166  lquery = ( lwork.EQ.-1 )
167  upper = lsame( uplo, 'U' )
168  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
169  info = -1
170  ELSE IF( n.LT.0 ) THEN
171  info = -2
172  ELSE IF( lda.LT.max( 1, n ) ) THEN
173  info = -4
174  ELSE IF( lwork.LT.max( 1, n-1 ) .AND. .NOT.lquery ) THEN
175  info = -7
176  END IF
177 *
178  IF( info.EQ.0 ) THEN
179  IF( upper ) THEN
180  nb = ilaenv( 1, 'ZUNGQL', ' ', n-1, n-1, n-1, -1 )
181  ELSE
182  nb = ilaenv( 1, 'ZUNGQR', ' ', n-1, n-1, n-1, -1 )
183  END IF
184  lwkopt = max( 1, n-1 )*nb
185  work( 1 ) = lwkopt
186  END IF
187 *
188  IF( info.NE.0 ) THEN
189  CALL xerbla( 'ZUNGTR', -info )
190  return
191  ELSE IF( lquery ) THEN
192  return
193  END IF
194 *
195 * Quick return if possible
196 *
197  IF( n.EQ.0 ) THEN
198  work( 1 ) = 1
199  return
200  END IF
201 *
202  IF( upper ) THEN
203 *
204 * Q was determined by a call to ZHETRD with UPLO = 'U'
205 *
206 * Shift the vectors which define the elementary reflectors one
207 * column to the left, and set the last row and column of Q to
208 * those of the unit matrix
209 *
210  DO 20 j = 1, n - 1
211  DO 10 i = 1, j - 1
212  a( i, j ) = a( i, j+1 )
213  10 continue
214  a( n, j ) = zero
215  20 continue
216  DO 30 i = 1, n - 1
217  a( i, n ) = zero
218  30 continue
219  a( n, n ) = one
220 *
221 * Generate Q(1:n-1,1:n-1)
222 *
223  CALL zungql( n-1, n-1, n-1, a, lda, tau, work, lwork, iinfo )
224 *
225  ELSE
226 *
227 * Q was determined by a call to ZHETRD with UPLO = 'L'.
228 *
229 * Shift the vectors which define the elementary reflectors one
230 * column to the right, and set the first row and column of Q to
231 * those of the unit matrix
232 *
233  DO 50 j = n, 2, -1
234  a( 1, j ) = zero
235  DO 40 i = j + 1, n
236  a( i, j ) = a( i, j-1 )
237  40 continue
238  50 continue
239  a( 1, 1 ) = one
240  DO 60 i = 2, n
241  a( i, 1 ) = zero
242  60 continue
243  IF( n.GT.1 ) THEN
244 *
245 * Generate Q(2:n,2:n)
246 *
247  CALL zungqr( n-1, n-1, n-1, a( 2, 2 ), lda, tau, work,
248  $ lwork, iinfo )
249  END IF
250  END IF
251  work( 1 ) = lwkopt
252  return
253 *
254 * End of ZUNGTR
255 *
256  END