Desire NUENTSA | 9cf77ce | 2012-11-12 15:20:37 +0100 | [diff] [blame] | 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 |