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 204