LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slarfg.f
Go to the documentation of this file.
1*> \brief \b SLARFG 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 SLARFG + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfg.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfg.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfg.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
22*
23* .. Scalar Arguments ..
24* INTEGER INCX, N
25* REAL ALPHA, TAU
26* ..
27* .. Array Arguments ..
28* REAL X( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> SLARFG generates a real elementary reflector H of order n, such
38*> that
39*>
40*> H * ( alpha ) = ( beta ), H**T * H = I.
41*> ( x ) ( 0 )
42*>
43*> where alpha and beta are scalars, and x is an (n-1)-element real
44*> vector. H is represented in the form
45*>
46*> H = I - tau * ( 1 ) * ( 1 v**T ) ,
47*> ( v )
48*>
49*> where tau is a real scalar and v is a real (n-1)-element
50*> vector.
51*>
52*> If the elements of x are all zero, then tau = 0 and H is taken to be
53*> the unit matrix.
54*>
55*> Otherwise 1 <= tau <= 2.
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 REAL
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 REAL 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 REAL
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 slarfg( 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 REAL ALPHA, TAU
114* ..
115* .. Array Arguments ..
116 REAL X( * )
117* ..
118*
119* =====================================================================
120*
121* .. Parameters ..
122 REAL ONE, ZERO
123 parameter( one = 1.0e+0, zero = 0.0e+0 )
124* ..
125* .. Local Scalars ..
126 INTEGER J, KNT
127 REAL BETA, RSAFMN, SAFMIN, XNORM
128* ..
129* .. External Functions ..
130 REAL SLAMCH, SLAPY2, SNRM2
131 EXTERNAL slamch, slapy2, snrm2
132* ..
133* .. Intrinsic Functions ..
134 INTRINSIC abs, sign
135* ..
136* .. External Subroutines ..
137 EXTERNAL sscal
138* ..
139* .. Executable Statements ..
140*
141 IF( n.LE.1 ) THEN
142 tau = zero
143 RETURN
144 END IF
145*
146 xnorm = snrm2( n-1, x, incx )
147*
148 IF( xnorm.EQ.zero ) THEN
149*
150* H = I
151*
152 tau = zero
153 ELSE
154*
155* general case
156*
157 beta = -sign( slapy2( alpha, xnorm ), alpha )
158 safmin = slamch( 'S' ) / slamch( 'E' )
159 knt = 0
160 IF( abs( beta ).LT.safmin ) THEN
161*
162* XNORM, BETA may be inaccurate; scale X and recompute them
163*
164 rsafmn = one / safmin
165 10 CONTINUE
166 knt = knt + 1
167 CALL sscal( n-1, rsafmn, x, incx )
168 beta = beta*rsafmn
169 alpha = alpha*rsafmn
170 IF( (abs( beta ).LT.safmin) .AND. (knt .LT. 20) )
171 $ GO TO 10
172*
173* New BETA is at most 1, at least SAFMIN
174*
175 xnorm = snrm2( n-1, x, incx )
176 beta = -sign( slapy2( alpha, xnorm ), alpha )
177 END IF
178 tau = ( beta-alpha ) / beta
179 CALL sscal( n-1, one / ( alpha-beta ), x, incx )
180*
181* If ALPHA is subnormal, it may lose relative accuracy
182*
183 DO 20 j = 1, knt
184 beta = beta*safmin
185 20 CONTINUE
186 alpha = beta
187 END IF
188*
189 RETURN
190*
191* End of SLARFG
192*
193 END
subroutine slarfg(n, alpha, x, incx, tau)
SLARFG generates an elementary reflector (Householder matrix).
Definition slarfg.f:106
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79