LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zlarfg.f
Go to the documentation of this file.
1*> \brief \b ZLARFG generates an elementary reflector (Householder matrix).
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLARFG + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfg.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfg.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfg.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
22*
23* .. Scalar Arguments ..
24* INTEGER INCX, N
25* COMPLEX*16 ALPHA, TAU
26* ..
27* .. Array Arguments ..
28* COMPLEX*16 X( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> ZLARFG generates a complex elementary reflector H of order n, such
38*> that
39*>
40*> H**H * ( alpha ) = ( beta ), H**H * H = I.
41*> ( x ) ( 0 )
42*>
43*> where alpha and beta are scalars, with beta real, and x is an
44*> (n-1)-element complex vector. H is represented in the form
45*>
46*> H = I - tau * ( 1 ) * ( 1 v**H ) ,
47*> ( v )
48*>
49*> where tau is a complex scalar and v is a complex (n-1)-element
50*> vector. Note that H is not hermitian.
51*>
52*> If the elements of x are all zero and alpha is real, then tau = 0
53*> and H is taken to be the unit matrix.
54*>
55*> Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
56*> \endverbatim
57*
58* Arguments:
59* ==========
60*
61*> \param[in] N
62*> \verbatim
63*> N is INTEGER
64*> The order of the elementary reflector.
65*> \endverbatim
66*>
67*> \param[in,out] ALPHA
68*> \verbatim
69*> ALPHA is COMPLEX*16
70*> On entry, the value alpha.
71*> On exit, it is overwritten with the value beta.
72*> \endverbatim
73*>
74*> \param[in,out] X
75*> \verbatim
76*> X is COMPLEX*16 array, dimension
77*> (1+(N-2)*abs(INCX))
78*> On entry, the vector x.
79*> On exit, it is overwritten with the vector v.
80*> \endverbatim
81*>
82*> \param[in] INCX
83*> \verbatim
84*> INCX is INTEGER
85*> The increment between elements of X. INCX > 0.
86*> \endverbatim
87*>
88*> \param[out] TAU
89*> \verbatim
90*> TAU is COMPLEX*16
91*> The value tau.
92*> \endverbatim
93*
94* Authors:
95* ========
96*
97*> \author Univ. of Tennessee
98*> \author Univ. of California Berkeley
99*> \author Univ. of Colorado Denver
100*> \author NAG Ltd.
101*
102*> \ingroup larfg
103*
104* =====================================================================
105 SUBROUTINE zlarfg( N, ALPHA, X, INCX, TAU )
106*
107* -- LAPACK auxiliary routine --
108* -- LAPACK is a software package provided by Univ. of Tennessee, --
109* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
110*
111* .. Scalar Arguments ..
112 INTEGER INCX, N
113 COMPLEX*16 ALPHA, TAU
114* ..
115* .. Array Arguments ..
116 COMPLEX*16 X( * )
117* ..
118*
119* =====================================================================
120*
121* .. Parameters ..
122 DOUBLE PRECISION ONE, ZERO
123 parameter( one = 1.0d+0, zero = 0.0d+0 )
124* ..
125* .. Local Scalars ..
126 INTEGER J, KNT
127 DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
128* ..
129* .. External Functions ..
130 DOUBLE PRECISION DLAMCH, DLAPY3, DZNRM2
131 COMPLEX*16 ZLADIV
132 EXTERNAL dlamch, dlapy3, dznrm2, zladiv
133* ..
134* .. Intrinsic Functions ..
135 INTRINSIC abs, dble, dcmplx, dimag, sign
136* ..
137* .. External Subroutines ..
138 EXTERNAL zdscal, zscal
139* ..
140* .. Executable Statements ..
141*
142 IF( n.LE.0 ) THEN
143 tau = zero
144 RETURN
145 END IF
146*
147 xnorm = dznrm2( n-1, x, incx )
148 alphr = dble( alpha )
149 alphi = dimag( alpha )
150*
151 IF( xnorm.EQ.zero .AND. alphi.EQ.zero ) THEN
152*
153* H = I
154*
155 tau = zero
156 ELSE
157*
158* general case
159*
160 beta = -sign( dlapy3( alphr, alphi, xnorm ), alphr )
161 safmin = dlamch( 'S' ) / dlamch( 'E' )
162 rsafmn = one / safmin
163*
164 knt = 0
165 IF( abs( beta ).LT.safmin ) THEN
166*
167* XNORM, BETA may be inaccurate; scale X and recompute them
168*
169 10 CONTINUE
170 knt = knt + 1
171 CALL zdscal( n-1, rsafmn, x, incx )
172 beta = beta*rsafmn
173 alphi = alphi*rsafmn
174 alphr = alphr*rsafmn
175 IF( (abs( beta ).LT.safmin) .AND. (knt .LT. 20) )
176 $ GO TO 10
177*
178* New BETA is at most 1, at least SAFMIN
179*
180 xnorm = dznrm2( n-1, x, incx )
181 alpha = dcmplx( alphr, alphi )
182 beta = -sign( dlapy3( alphr, alphi, xnorm ), alphr )
183 END IF
184 tau = dcmplx( ( beta-alphr ) / beta, -alphi / beta )
185 alpha = zladiv( dcmplx( one ), alpha-beta )
186 CALL zscal( n-1, alpha, x, incx )
187*
188* If ALPHA is subnormal, it may lose relative accuracy
189*
190 DO 20 j = 1, knt
191 beta = beta*safmin
192 20 CONTINUE
193 alpha = beta
194 END IF
195*
196 RETURN
197*
198* End of ZLARFG
199*
200 END
subroutine zlarfg(n, alpha, x, incx, tau)
ZLARFG generates an elementary reflector (Householder matrix).
Definition zlarfg.f:106
subroutine zdscal(n, da, zx, incx)
ZDSCAL
Definition zdscal.f:78
subroutine zscal(n, za, zx, incx)
ZSCAL
Definition zscal.f:78