17faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \brief \b SLARFG 27faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 37faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* =========== DOCUMENTATION =========== 47faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 57faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Online html documentation available at 67faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* http://www.netlib.org/lapack/explore-html/ 77faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 87faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \htmlonly 97faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> Download SLARFG + dependencies 107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfg.f"> 117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [TGZ]</a> 127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfg.f"> 137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [ZIP]</a> 147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfg.f"> 157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [TXT]</a> 167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endhtmlonly 177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Definition: 197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* =========== 207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU ) 227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Scalar Arguments .. 247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* INTEGER INCX, N 257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* REAL ALPHA, TAU 267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Array Arguments .. 287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* REAL X( * ) 297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \par Purpose: 337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ============= 347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> SLARFG generates a real elementary reflector H of order n, such 387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> that 397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> H * ( alpha ) = ( beta ), H**T * H = I. 417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( x ) ( 0 ) 427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> where alpha and beta are scalars, and x is an (n-1)-element real 447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> vector. H is represented in the form 457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> H = I - tau * ( 1 ) * ( 1 v**T ) , 477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( v ) 487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> where tau is a real scalar and v is a real (n-1)-element 507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> vector. 517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> If the elements of x are all zero, then tau = 0 and H is taken to be 537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> the unit matrix. 547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> Otherwise 1 <= tau <= 2. 567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Arguments: 597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ========== 607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] N 627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> N is INTEGER 647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The order of the elementary reflector. 657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in,out] ALPHA 687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ALPHA is REAL 707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> On entry, the value alpha. 717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> On exit, it is overwritten with the value beta. 727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in,out] X 757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> X is REAL array, dimension 777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> (1+(N-2)*abs(INCX)) 787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> On entry, the vector x. 797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> On exit, it is overwritten with the vector v. 807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] INCX 837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> INCX is INTEGER 857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The increment between elements of X. INCX > 0. 867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[out] TAU 897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> TAU is REAL 917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The value tau. 927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Authors: 957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ======== 967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author Univ. of Tennessee 987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author Univ. of California Berkeley 997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author Univ. of Colorado Denver 1007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author NAG Ltd. 1017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \date November 2011 1037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \ingroup realOTHERauxiliary 1057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ===================================================================== 1077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU ) 1087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* -- LAPACK auxiliary routine (version 3.4.0) -- 1107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* -- LAPACK is a software package provided by Univ. of Tennessee, -- 1117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 1127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* November 2011 1137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Scalar Arguments .. 1157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTEGER INCX, N 1167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL ALPHA, TAU 1177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Array Arguments .. 1197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL X( * ) 1207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ===================================================================== 1237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Parameters .. 1257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL ONE, ZERO 1267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 1277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Local Scalars .. 1297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTEGER J, KNT 1307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL BETA, RSAFMN, SAFMIN, XNORM 1317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. External Functions .. 1337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL SLAMCH, SLAPY2, SNRM2 1347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez EXTERNAL SLAMCH, SLAPY2, SNRM2 1357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Intrinsic Functions .. 1377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTRINSIC ABS, SIGN 1387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. External Subroutines .. 1407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez EXTERNAL SSCAL 1417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 1427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Executable Statements .. 1437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( N.LE.1 ) THEN 1457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TAU = ZERO 1467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez RETURN 1477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 1487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez XNORM = SNRM2( N-1, X, INCX ) 1507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( XNORM.EQ.ZERO ) THEN 1527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* H = I 1547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TAU = ZERO 1567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 1577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* general case 1597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA ) 1617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' ) 1627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez KNT = 0 1637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( ABS( BETA ).LT.SAFMIN ) THEN 1647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* XNORM, BETA may be inaccurate; scale X and recompute them 1667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez RSAFMN = ONE / SAFMIN 1687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 10 CONTINUE 1697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez KNT = KNT + 1 1707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SSCAL( N-1, RSAFMN, X, INCX ) 1717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez BETA = BETA*RSAFMN 1727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ALPHA = ALPHA*RSAFMN 1737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( ABS( BETA ).LT.SAFMIN ) 1747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ GO TO 10 1757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* New BETA is at most 1, at least SAFMIN 1777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez XNORM = SNRM2( N-1, X, INCX ) 1797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA ) 1807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 1817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TAU = ( BETA-ALPHA ) / BETA 1827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX ) 1837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* If ALPHA is subnormal, it may lose relative accuracy 1857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 20 J = 1, KNT 1877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez BETA = BETA*SAFMIN 1887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 20 CONTINUE 1897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ALPHA = BETA 1907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 1917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez RETURN 1937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* End of SLARFG 1957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END 197