LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
clarfg.f
Go to the documentation of this file.
1 *> \brief \b CLARFG 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 CLARFG + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarfg.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarfg.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarfg.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INCX, N
25 * COMPLEX ALPHA, TAU
26 * ..
27 * .. Array Arguments ..
28 * COMPLEX X( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> CLARFG 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
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 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
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 complexOTHERauxiliary
103 *
104 * =====================================================================
105  SUBROUTINE clarfg( 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 ALPHA, TAU
114 * ..
115 * .. Array Arguments ..
116  COMPLEX 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 ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
128 * ..
129 * .. External Functions ..
130  REAL SCNRM2, SLAMCH, SLAPY3
131  COMPLEX CLADIV
132  EXTERNAL scnrm2, slamch, slapy3, cladiv
133 * ..
134 * .. Intrinsic Functions ..
135  INTRINSIC abs, aimag, cmplx, real, sign
136 * ..
137 * .. External Subroutines ..
138  EXTERNAL cscal, csscal
139 * ..
140 * .. Executable Statements ..
141 *
142  IF( n.LE.0 ) THEN
143  tau = zero
144  RETURN
145  END IF
146 *
147  xnorm = scnrm2( n-1, x, incx )
148  alphr = real( alpha )
149  alphi = aimag( 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( slapy3( alphr, alphi, xnorm ), alphr )
161  safmin = slamch( 'S' ) / slamch( '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 csscal( 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 = scnrm2( n-1, x, incx )
181  alpha = cmplx( alphr, alphi )
182  beta = -sign( slapy3( alphr, alphi, xnorm ), alphr )
183  END IF
184  tau = cmplx( ( beta-alphr ) / beta, -alphi / beta )
185  alpha = cladiv( cmplx( one ), alpha-beta )
186  CALL cscal( 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 CLARFG
199 *
200  END
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:78
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
Definition: clarfg.f:106