LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
zunghr.f
Go to the documentation of this file.
1 *> \brief \b ZUNGHR
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZUNGHR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunghr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunghr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunghr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER IHI, ILO, INFO, LDA, LWORK, N
25 * ..
26 * .. Array Arguments ..
27 * COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> ZUNGHR generates a complex unitary matrix Q which is defined as the
37 *> product of IHI-ILO elementary reflectors of order N, as returned by
38 *> ZGEHRD:
39 *>
40 *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
41 *> \endverbatim
42 *
43 * Arguments:
44 * ==========
45 *
46 *> \param[in] N
47 *> \verbatim
48 *> N is INTEGER
49 *> The order of the matrix Q. N >= 0.
50 *> \endverbatim
51 *>
52 *> \param[in] ILO
53 *> \verbatim
54 *> ILO is INTEGER
55 *> \endverbatim
56 *>
57 *> \param[in] IHI
58 *> \verbatim
59 *> IHI is INTEGER
60 *>
61 *> ILO and IHI must have the same values as in the previous call
62 *> of ZGEHRD. Q is equal to the unit matrix except in the
63 *> submatrix Q(ilo+1:ihi,ilo+1:ihi).
64 *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
65 *> \endverbatim
66 *>
67 *> \param[in,out] A
68 *> \verbatim
69 *> A is COMPLEX*16 array, dimension (LDA,N)
70 *> On entry, the vectors which define the elementary reflectors,
71 *> as returned by ZGEHRD.
72 *> On exit, the N-by-N unitary matrix Q.
73 *> \endverbatim
74 *>
75 *> \param[in] LDA
76 *> \verbatim
77 *> LDA is INTEGER
78 *> The leading dimension of the array A. LDA >= max(1,N).
79 *> \endverbatim
80 *>
81 *> \param[in] TAU
82 *> \verbatim
83 *> TAU is COMPLEX*16 array, dimension (N-1)
84 *> TAU(i) must contain the scalar factor of the elementary
85 *> reflector H(i), as returned by ZGEHRD.
86 *> \endverbatim
87 *>
88 *> \param[out] WORK
89 *> \verbatim
90 *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
91 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
92 *> \endverbatim
93 *>
94 *> \param[in] LWORK
95 *> \verbatim
96 *> LWORK is INTEGER
97 *> The dimension of the array WORK. LWORK >= IHI-ILO.
98 *> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
99 *> the optimal blocksize.
100 *>
101 *> If LWORK = -1, then a workspace query is assumed; the routine
102 *> only calculates the optimal size of the WORK array, returns
103 *> this value as the first entry of the WORK array, and no error
104 *> message related to LWORK is issued by XERBLA.
105 *> \endverbatim
106 *>
107 *> \param[out] INFO
108 *> \verbatim
109 *> INFO is INTEGER
110 *> = 0: successful exit
111 *> < 0: if INFO = -i, the i-th argument had an illegal value
112 *> \endverbatim
113 *
114 * Authors:
115 * ========
116 *
117 *> \author Univ. of Tennessee
118 *> \author Univ. of California Berkeley
119 *> \author Univ. of Colorado Denver
120 *> \author NAG Ltd.
121 *
122 *> \date December 2016
123 *
124 *> \ingroup complex16OTHERcomputational
125 *
126 * =====================================================================
127  SUBROUTINE zunghr( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
128 *
129 * -- LAPACK computational routine (version 3.7.0) --
130 * -- LAPACK is a software package provided by Univ. of Tennessee, --
131 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132 * December 2016
133 *
134 * .. Scalar Arguments ..
135  INTEGER IHI, ILO, INFO, LDA, LWORK, N
136 * ..
137 * .. Array Arguments ..
138  COMPLEX*16 A( lda, * ), TAU( * ), WORK( * )
139 * ..
140 *
141 * =====================================================================
142 *
143 * .. Parameters ..
144  COMPLEX*16 ZERO, ONE
145  parameter( zero = ( 0.0d+0, 0.0d+0 ),
146  $ one = ( 1.0d+0, 0.0d+0 ) )
147 * ..
148 * .. Local Scalars ..
149  LOGICAL LQUERY
150  INTEGER I, IINFO, J, LWKOPT, NB, NH
151 * ..
152 * .. External Subroutines ..
153  EXTERNAL xerbla, zungqr
154 * ..
155 * .. External Functions ..
156  INTEGER ILAENV
157  EXTERNAL ilaenv
158 * ..
159 * .. Intrinsic Functions ..
160  INTRINSIC max, min
161 * ..
162 * .. Executable Statements ..
163 *
164 * Test the input arguments
165 *
166  info = 0
167  nh = ihi - ilo
168  lquery = ( lwork.EQ.-1 )
169  IF( n.LT.0 ) THEN
170  info = -1
171  ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
172  info = -2
173  ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
174  info = -3
175  ELSE IF( lda.LT.max( 1, n ) ) THEN
176  info = -5
177  ELSE IF( lwork.LT.max( 1, nh ) .AND. .NOT.lquery ) THEN
178  info = -8
179  END IF
180 *
181  IF( info.EQ.0 ) THEN
182  nb = ilaenv( 1, 'ZUNGQR', ' ', nh, nh, nh, -1 )
183  lwkopt = max( 1, nh )*nb
184  work( 1 ) = lwkopt
185  END IF
186 *
187  IF( info.NE.0 ) THEN
188  CALL xerbla( 'ZUNGHR', -info )
189  RETURN
190  ELSE IF( lquery ) THEN
191  RETURN
192  END IF
193 *
194 * Quick return if possible
195 *
196  IF( n.EQ.0 ) THEN
197  work( 1 ) = 1
198  RETURN
199  END IF
200 *
201 * Shift the vectors which define the elementary reflectors one
202 * column to the right, and set the first ilo and the last n-ihi
203 * rows and columns to those of the unit matrix
204 *
205  DO 40 j = ihi, ilo + 1, -1
206  DO 10 i = 1, j - 1
207  a( i, j ) = zero
208  10 CONTINUE
209  DO 20 i = j + 1, ihi
210  a( i, j ) = a( i, j-1 )
211  20 CONTINUE
212  DO 30 i = ihi + 1, n
213  a( i, j ) = zero
214  30 CONTINUE
215  40 CONTINUE
216  DO 60 j = 1, ilo
217  DO 50 i = 1, n
218  a( i, j ) = zero
219  50 CONTINUE
220  a( j, j ) = one
221  60 CONTINUE
222  DO 80 j = ihi + 1, n
223  DO 70 i = 1, n
224  a( i, j ) = zero
225  70 CONTINUE
226  a( j, j ) = one
227  80 CONTINUE
228 *
229  IF( nh.GT.0 ) THEN
230 *
231 * Generate Q(ilo+1:ihi,ilo+1:ihi)
232 *
233  CALL zungqr( nh, nh, nh, a( ilo+1, ilo+1 ), lda, tau( ilo ),
234  $ work, lwork, iinfo )
235  END IF
236  work( 1 ) = lwkopt
237  RETURN
238 *
239 * End of ZUNGHR
240 *
241  END
subroutine zungqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGQR
Definition: zungqr.f:130
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
Definition: zunghr.f:128
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62