3 * =========== DOCUMENTATION
===========
5 * Online html documentation available at
6 * http
://www
.netlib
.org
/lapack
/explore
-html
/
9 *> Download CLARFG
+ dependencies
10 *> <a href
="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarfg.f">
12 *> <a href
="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarfg.f">
14 *> <a href
="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarfg.f">
21 * SUBROUTINE CLARFG
( N
, ALPHA
, X
, INCX
, TAU
)
23 * .. Scalar Arguments
..
27 * .. Array Arguments
..
37 *> CLARFG generates a
complex elementary reflector H of order n
, such
40 *> H**H
* ( alpha
) = ( beta
), H**H
* H
= I
.
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
) ,
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 .
64 *> The order of the elementary reflector
.
67 *> \param
[in
,out
] ALPHA
70 *> On entry
, the value alpha
.
71 *> On exit
, it is overwritten with the value beta
.
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
.
85 *> The increment between elements of X
. INCX
> 0.
97 *> \author Univ
. of Tennessee
98 *> \author Univ
. of California Berkeley
99 *> \author Univ
. of Colorado Denver
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
..--
114 * .. Scalar Arguments
..
118 * .. Array Arguments
..
122 * =====================================================================
126 PARAMETER ( ONE
= 1.0E+0, ZERO
= 0.0E+0 )
128 * .. Local Scalars
..
130 REAL ALPHI
, ALPHR
, BETA
, RSAFMN
, SAFMIN
, XNORM
132 * .. External Functions
..
133 REAL SCNRM2
, SLAMCH
, SLAPY3
135 EXTERNAL SCNRM2
, SLAMCH
, SLAPY3
, CLADIV
137 * .. Intrinsic Functions
..
138 INTRINSIC ABS
, AIMAG
, CMPLX
, REAL, SIGN
140 * .. External Subroutines
..
141 EXTERNAL CSCAL
, CSSCAL
143 * .. Executable Statements
..
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
163 BETA
= -SIGN
( SLAPY3
( ALPHR
, ALPHI
, XNORM
), ALPHR
)
164 SAFMIN
= SLAMCH
( 'S' ) / SLAMCH
( 'E' )
165 RSAFMN
= ONE
/ SAFMIN
168 IF( ABS
( BETA
).LT
.SAFMIN
) THEN
170 * XNORM
, BETA may be inaccurate
; scale X and recompute them
174 CALL CSSCAL
( N
-1, RSAFMN
, X
, INCX
)
178 IF( ABS
( BETA
).LT
.SAFMIN
)
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
)
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