Numérotation des lignes :

C DLARFG    SOURCE    BP208322  18/07/10    21:15:14     9872           *> \brief \b DLARFG generates an elementary reflector (Householder matrix).**  =========== DOCUMENTATION ===========** Online html documentation available at*            http://www.netlib.org/lapack/explore-html/**> \htmlonly*> Download DLARFG + dependencies*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfg.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfg.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfg.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )**       .. Scalar Arguments ..*       INTEGER            INCX, N*       REAL*8   ALPHA, TAU*       ..*       .. Array Arguments ..*       REAL*8   X( * )*       ..***> \par Purpose:*  =============*>*> \verbatim*>*> DLARFG generates a real elementary reflector H of order n, such*> that*>*>       H * ( alpha ) = ( beta ),   H**T * H = I.*>           (   x   )   (   0  )*>*> where alpha and beta are scalars, and x is an (n-1)-element real*> vector. H is represented in the form*>*>       H = I - tau * ( 1 ) * ( 1 v**T ) ,*>                     ( v )*>*> where tau is a real scalar and v is a real (n-1)-element*> vector.*>*> If the elements of x are all zero, then tau = 0 and H is taken to be*> the unit matrix.*>*> Otherwise  1 &lt;= tau &lt;= 2.*> \endverbatim**  Arguments:*  ==========**> \param[in] N*> \verbatim*>          N is INTEGER*>          The order of the elementary reflector.*> \endverbatim*>*> \param[in,out] ALPHA*> \verbatim*>          ALPHA is DOUBLE PRECISION*>          On entry, the value alpha.*>          On exit, it is overwritten with the value beta.*> \endverbatim*>*> \param[in,out] X*> \verbatim*>          X is DOUBLE PRECISION 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 DOUBLE PRECISION*>          The value tau.*> \endverbatim**  Authors:*  ========**> \author Univ. of Tennessee*> \author Univ. of California Berkeley*> \author Univ. of Colorado Denver*> \author NAG Ltd.**> \date November 2017**> \ingroup doubleOTHERauxiliary**  =====================================================================      SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU )**  -- LAPACK auxiliary routine (version 3.8.0) --*  -- LAPACK is a software package provided by Univ. of Tennessee,    --*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--*     November 2017**     .. Scalar Arguments ..      INTEGER            INCX, N      REAL*8   ALPHA, TAU*     ..*     .. Array Arguments ..      REAL*8   X( * )*     ..**  =====================================================================**     .. Parameters ..      REAL*8   ONE, ZERO      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )*     ..*     .. Local Scalars ..      INTEGER            J, KNT      REAL*8   BETA, RSAFMN, SAFMIN, XNORM*     ..*     .. External Functions ..      REAL*8   DLAMCH, DLAPY2, DNRM2      EXTERNAL           DLAMCH, DLAPY2, DNRM2*     ..**     .. Intrinsic Functions ..*      INTRINSIC          ABS, SIGN**     ..**     .. External Subroutines ..*      EXTERNAL           DSCAL**     ..**     .. Executable Statements ..*      IF( N.LE.1 ) THEN         TAU = ZERO         RETURN      END IF*      XNORM = DNRM2( N-1, X, INCX )*      IF( XNORM.EQ.ZERO ) THEN**        H  =  I*         TAU = ZERO      ELSE**        general case*         BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )         SAFMIN = DLAMCH( 'S' ) / DLAMCH( 'E' )         KNT = 0         IF( ABS( BETA ).LT.SAFMIN ) THEN**           XNORM, BETA may be inaccurate; scale X and recompute them*            RSAFMN = ONE / SAFMIN   10       CONTINUE            KNT = KNT + 1            CALL DSCAL( N-1, RSAFMN, X, INCX )            BETA = BETA*RSAFMN            ALPHA = ALPHA*RSAFMN            IF( (ABS( BETA ).LT.SAFMIN) .AND. (KNT .LT. 20) )     \$         GO TO 10**           New BETA is at most 1, at least SAFMIN*            XNORM = DNRM2( N-1, X, INCX )            BETA = -SIGN( DLAPY2( ALPHA, XNORM ), ALPHA )         END IF         TAU = ( BETA-ALPHA ) / BETA         CALL DSCAL( N-1, ONE / ( ALPHA-BETA ), 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 DLARFG*      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales