source: pacpussensors/trunk/Vislab/lib3dv-1.2.0/lib3dv/eigen/lapack/zlarfg.f

Last change on this file was 136, checked in by ldecherf, 8 years ago

Doc

File size: 5.2 KB
Line 
1*> \brief \b ZLARFG
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*> \date November 2011
103*
104*> \ingroup complex16OTHERauxiliary
105*
106* =====================================================================
107 SUBROUTINE ZLARFG( N, ALPHA, X, INCX, TAU )
108*
109* -- LAPACK auxiliary routine (version 3.4.0) --
110* -- LAPACK is a software package provided by Univ. of Tennessee, --
111* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112* November 2011
113*
114* .. Scalar Arguments ..
115 INTEGER INCX, N
116 COMPLEX*16 ALPHA, TAU
117* ..
118* .. Array Arguments ..
119 COMPLEX*16 X( * )
120* ..
121*
122* =====================================================================
123*
124* .. Parameters ..
125 DOUBLE PRECISION ONE, ZERO
126 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
127* ..
128* .. Local Scalars ..
129 INTEGER J, KNT
130 DOUBLE PRECISION ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
131* ..
132* .. External Functions ..
133 DOUBLE PRECISION DLAMCH, DLAPY3, DZNRM2
134 COMPLEX*16 ZLADIV
135 EXTERNAL DLAMCH, DLAPY3, DZNRM2, ZLADIV
136* ..
137* .. Intrinsic Functions ..
138 INTRINSIC ABS, DBLE, DCMPLX, DIMAG, SIGN
139* ..
140* .. External Subroutines ..
141 EXTERNAL ZDSCAL, ZSCAL
142* ..
143* .. Executable Statements ..
144*
145 IF( N.LE.0 ) THEN
146 TAU = ZERO
147 RETURN
148 END IF
149*
150 XNORM = DZNRM2( N-1, X, INCX )
151 ALPHR = DBLE( ALPHA )
152 ALPHI = DIMAG( ALPHA )
153*
154 IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
155*
156* H = I
157*
158 TAU = ZERO
159 ELSE
160*
161* general case
162*
163 BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
164 SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )
165 RSAFMN = ONE / SAFMIN
166*
167 KNT = 0
168 IF( ABS( BETA ).LT.SAFMIN ) THEN
169*
170* XNORM, BETA may be inaccurate; scale X and recompute them
171*
172 10 CONTINUE
173 KNT = KNT + 1
174 CALL ZDSCAL( N-1, RSAFMN, X, INCX )
175 BETA = BETA*RSAFMN
176 ALPHI = ALPHI*RSAFMN
177 ALPHR = ALPHR*RSAFMN
178 IF( ABS( BETA ).LT.SAFMIN )
179 $ GO TO 10
180*
181* New BETA is at most 1, at least SAFMIN
182*
183 XNORM = DZNRM2( N-1, X, INCX )
184 ALPHA = DCMPLX( ALPHR, ALPHI )
185 BETA = -SIGN( DLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
186 END IF
187 TAU = DCMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
188 ALPHA = ZLADIV( DCMPLX( ONE ), ALPHA-BETA )
189 CALL ZSCAL( N-1, ALPHA, X, INCX )
190*
191* If ALPHA is subnormal, it may lose relative accuracy
192*
193 DO 20 J = 1, KNT
194 BETA = BETA*SAFMIN
195 20 CONTINUE
196 ALPHA = BETA
197 END IF
198*
199 RETURN
200*
201* End of ZLARFG
202*
203 END
Note: See TracBrowser for help on using the repository browser.