Squashed 'third_party/eigen/' content from commit 61d72f6
Change-Id: Iccc90fa0b55ab44037f018046d2fcffd90d9d025
git-subtree-dir: third_party/eigen
git-subtree-split: 61d72f6383cfa842868c53e30e087b0258177257
diff --git a/lapack/clarfg.f b/lapack/clarfg.f
new file mode 100644
index 0000000..d64f396
--- /dev/null
+++ b/lapack/clarfg.f
@@ -0,0 +1,203 @@
+*> \brief \b CLARFG
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLARFG + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarfg.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarfg.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarfg.f">
+*> [TXT]</a>
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
+*
+* .. Scalar Arguments ..
+* INTEGER INCX, N
+* COMPLEX ALPHA, TAU
+* ..
+* .. Array Arguments ..
+* COMPLEX X( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLARFG generates a complex elementary reflector H of order n, such
+*> that
+*>
+*> H**H * ( alpha ) = ( beta ), H**H * H = I.
+*> ( x ) ( 0 )
+*>
+*> where alpha and beta are scalars, with beta real, and x is an
+*> (n-1)-element complex vector. H is represented in the form
+*>
+*> H = I - tau * ( 1 ) * ( 1 v**H ) ,
+*> ( v )
+*>
+*> where tau is a complex scalar and v is a complex (n-1)-element
+*> vector. Note that H is not hermitian.
+*>
+*> If the elements of x are all zero and alpha is real, then tau = 0
+*> and H is taken to be the unit matrix.
+*>
+*> Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*> ALPHA is COMPLEX
+*> On entry, the value alpha.
+*> On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*> X is COMPLEX array, dimension
+*> (1+(N-2)*abs(INCX))
+*> On entry, the vector x.
+*> On exit, it is overwritten with the vector v.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*> INCX is INTEGER
+*> The increment between elements of X. INCX > 0.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX
+*> The value tau.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complexOTHERauxiliary
+*
+* =====================================================================
+ SUBROUTINE CLARFG( N, ALPHA, X, INCX, TAU )
+*
+* -- LAPACK auxiliary routine (version 3.4.0) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
+*
+* .. Scalar Arguments ..
+ INTEGER INCX, N
+ COMPLEX ALPHA, TAU
+* ..
+* .. Array Arguments ..
+ COMPLEX X( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ONE, ZERO
+ PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER J, KNT
+ REAL ALPHI, ALPHR, BETA, RSAFMN, SAFMIN, XNORM
+* ..
+* .. External Functions ..
+ REAL SCNRM2, SLAMCH, SLAPY3
+ COMPLEX CLADIV
+ EXTERNAL SCNRM2, SLAMCH, SLAPY3, CLADIV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, AIMAG, CMPLX, REAL, SIGN
+* ..
+* .. External Subroutines ..
+ EXTERNAL CSCAL, CSSCAL
+* ..
+* .. Executable Statements ..
+*
+ IF( N.LE.0 ) THEN
+ TAU = ZERO
+ RETURN
+ END IF
+*
+ XNORM = SCNRM2( N-1, X, INCX )
+ ALPHR = REAL( ALPHA )
+ ALPHI = AIMAG( ALPHA )
+*
+ IF( XNORM.EQ.ZERO .AND. ALPHI.EQ.ZERO ) THEN
+*
+* H = I
+*
+ TAU = ZERO
+ ELSE
+*
+* general case
+*
+ BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
+ RSAFMN = ONE / SAFMIN
+*
+ KNT = 0
+ IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+* XNORM, BETA may be inaccurate; scale X and recompute them
+*
+ 10 CONTINUE
+ KNT = KNT + 1
+ CALL CSSCAL( N-1, RSAFMN, X, INCX )
+ BETA = BETA*RSAFMN
+ ALPHI = ALPHI*RSAFMN
+ ALPHR = ALPHR*RSAFMN
+ IF( ABS( BETA ).LT.SAFMIN )
+ $ GO TO 10
+*
+* New BETA is at most 1, at least SAFMIN
+*
+ XNORM = SCNRM2( N-1, X, INCX )
+ ALPHA = CMPLX( ALPHR, ALPHI )
+ BETA = -SIGN( SLAPY3( ALPHR, ALPHI, XNORM ), ALPHR )
+ END IF
+ TAU = CMPLX( ( BETA-ALPHR ) / BETA, -ALPHI / BETA )
+ ALPHA = CLADIV( CMPLX( ONE ), ALPHA-BETA )
+ CALL CSCAL( N-1, ALPHA, X, INCX )
+*
+* If ALPHA is subnormal, it may lose relative accuracy
+*
+ DO 20 J = 1, KNT
+ BETA = BETA*SAFMIN
+ 20 CONTINUE
+ ALPHA = BETA
+ END IF
+*
+ RETURN
+*
+* End of CLARFG
+*
+ END