LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
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
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 realOTHERauxiliary
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