LP-311 Remove basic/advanced stabilization tab auto-switch (autotune/txpid lock issues)
[librepilot.git] / ground / gcs / src / libs / eigen / lapack / clarfg.f
blobd64f396c3d508a6ef0b1e7edd417c44b7a44800a
1 *> \brief \b CLARFG
3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
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
18 * Definition:
19 * ===========
21 * SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
23 * .. Scalar Arguments ..
24 * INTEGER INCX, N
25 * COMPLEX ALPHA, TAU
26 * ..
27 * .. Array Arguments ..
28 * COMPLEX X( * )
29 * ..
32 *> \par Purpose:
33 * =============
35 *> \verbatim
37 *> CLARFG generates a complex elementary reflector H of order n, such
38 *> that
40 *> H**H * ( alpha ) = ( beta ), H**H * H = I.
41 *> ( x ) ( 0 )
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
46 *> H = I - tau * ( 1 ) * ( 1 v**H ) ,
47 *> ( v )
49 *> where tau is a complex scalar and v is a complex (n-1)-element
50 *> vector. Note that H is not hermitian.
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.
55 *> Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
56 *> \endverbatim
58 * Arguments:
59 * ==========
61 *> \param[in] N
62 *> \verbatim
63 *> N is INTEGER
64 *> The order of the elementary reflector.
65 *> \endverbatim
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
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
82 *> \param[in] INCX
83 *> \verbatim
84 *> INCX is INTEGER
85 *> The increment between elements of X. INCX > 0.
86 *> \endverbatim
88 *> \param[out] TAU
89 *> \verbatim
90 *> TAU is COMPLEX
91 *> The value tau.
92 *> \endverbatim
94 * Authors:
95 * ========
97 *> \author Univ. of Tennessee
98 *> \author Univ. of California Berkeley
99 *> \author Univ. of Colorado Denver
100 *> \author NAG Ltd.
102 *> \date November 2011
104 *> \ingroup complexOTHERauxiliary
106 * =====================================================================
107 SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
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
114 * .. Scalar Arguments ..
115 INTEGER INCX, N
116 COMPLEX ALPHA, TAU
117 * ..
118 * .. Array Arguments ..
119 COMPLEX X( * )
120 * ..
122 * =====================================================================
124 * .. Parameters ..
125 REAL ONE, ZERO
126 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
127 * ..
128 * .. Local Scalars ..
129 INTEGER J, KNT
130 REAL ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
131 * ..
132 * .. External Functions ..
133 REAL SCNRM2, SLAMCH, SLAPY3
134 COMPLEX CLADIV
135 EXTERNAL SCNRM2, SLAMCH, SLAPY3, CLADIV
136 * ..
137 * .. Intrinsic Functions ..
138 INTRINSIC ABS, AIMAG, CMPLX, REAL, SIGN
139 * ..
140 * .. External Subroutines ..
141 EXTERNAL CSCAL, CSSCAL
142 * ..
143 * .. Executable Statements ..
145 IF( N.LE.0 ) THEN
146 TAU = ZERO
147 RETURN
148 END IF
150 XNORM = SCNRM2( N-1, X, INCX )
151 ALPHR = REAL( ALPHA )
152 ALPHI = AIMAG( ALPHA )
154 IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
156 * H = I
158 TAU = ZERO
159 ELSE
161 * general case
163 BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
164 SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
165 RSAFMN = ONE / SAFMIN
167 KNT = 0
168 IF( ABS( BETA ).LT.SAFMIN ) THEN
170 * XNORM, BETA may be inaccurate; scale X and recompute them
172 10 CONTINUE
173 KNT = KNT + 1
174 CALL CSSCAL( 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
181 * New BETA is at most 1, at least SAFMIN
183 XNORM = SCNRM2( N-1, X, INCX )
184 ALPHA = CMPLX( ALPHR, ALPHI )
185 BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
186 END IF
187 TAU = CMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
188 ALPHA = CLADIV( CMPLX( ONE ), ALPHA-BETA )
189 CALL CSCAL( N-1, ALPHA, X, INCX )
191 * If ALPHA is subnormal, it may lose relative accuracy
193 DO 20 J = 1, KNT
194 BETA = BETA*SAFMIN
195 20 CONTINUE
196 ALPHA = BETA
197 END IF
199 RETURN
201 * End of CLARFG