Return to dlassq.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de Lapack.

    1: *> \brief \b DLASSQ updates a sum of squares represented in scaled form.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLASSQ + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       INTEGER            INCX, N
   25: *       DOUBLE PRECISION   SCALE, SUMSQ
   26: *       ..
   27: *       .. Array Arguments ..
   28: *       DOUBLE PRECISION   X( * )
   29: *       ..
   30: *
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> DLASSQ  returns the values  scl  and  smsq  such that
   38: *>
   39: *>    ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
   40: *>
   41: *> where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
   42: *> assumed to be non-negative and  scl  returns the value
   43: *>
   44: *>    scl = max( scale, abs( x( i ) ) ).
   45: *>
   46: *> scale and sumsq must be supplied in SCALE and SUMSQ and
   47: *> scl and smsq are overwritten on SCALE and SUMSQ respectively.
   48: *>
   49: *> The routine makes only one pass through the vector x.
   50: *> \endverbatim
   51: *
   52: *  Arguments:
   53: *  ==========
   54: *
   55: *> \param[in] N
   56: *> \verbatim
   57: *>          N is INTEGER
   58: *>          The number of elements to be used from the vector X.
   59: *> \endverbatim
   60: *>
   61: *> \param[in] X
   62: *> \verbatim
   63: *>          X is DOUBLE PRECISION array, dimension (1+(N-1)*INCX)
   64: *>          The vector for which a scaled sum of squares is computed.
   65: *>             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
   66: *> \endverbatim
   67: *>
   68: *> \param[in] INCX
   69: *> \verbatim
   70: *>          INCX is INTEGER
   71: *>          The increment between successive values of the vector X.
   72: *>          INCX > 0.
   73: *> \endverbatim
   74: *>
   75: *> \param[in,out] SCALE
   76: *> \verbatim
   77: *>          SCALE is DOUBLE PRECISION
   78: *>          On entry, the value  scale  in the equation above.
   79: *>          On exit, SCALE is overwritten with  scl , the scaling factor
   80: *>          for the sum of squares.
   81: *> \endverbatim
   82: *>
   83: *> \param[in,out] SUMSQ
   84: *> \verbatim
   85: *>          SUMSQ is DOUBLE PRECISION
   86: *>          On entry, the value  sumsq  in the equation above.
   87: *>          On exit, SUMSQ is overwritten with  smsq , the basic sum of
   88: *>          squares from which  scl  has been factored out.
   89: *> \endverbatim
   90: *
   91: *  Authors:
   92: *  ========
   93: *
   94: *> \author Univ. of Tennessee
   95: *> \author Univ. of California Berkeley
   96: *> \author Univ. of Colorado Denver
   97: *> \author NAG Ltd.
   98: *
   99: *> \date December 2016
  100: *
  101: *> \ingroup OTHERauxiliary
  102: *
  103: *  =====================================================================
  104:       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
  105: *
  106: *  -- LAPACK auxiliary routine (version 3.7.0) --
  107: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  108: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  109: *     December 2016
  110: *
  111: *     .. Scalar Arguments ..
  112:       INTEGER            INCX, N
  113:       DOUBLE PRECISION   SCALE, SUMSQ
  114: *     ..
  115: *     .. Array Arguments ..
  116:       DOUBLE PRECISION   X( * )
  117: *     ..
  118: *
  119: * =====================================================================
  120: *
  121: *     .. Parameters ..
  122:       DOUBLE PRECISION   ZERO
  123:       PARAMETER          ( ZERO = 0.0D+0 )
  124: *     ..
  125: *     .. Local Scalars ..
  126:       INTEGER            IX
  127:       DOUBLE PRECISION   ABSXI
  128: *     ..
  129: *     .. External Functions ..
  130:       LOGICAL            DISNAN
  131:       EXTERNAL           DISNAN
  132: *     ..
  133: *     .. Intrinsic Functions ..
  134:       INTRINSIC          ABS
  135: *     ..
  136: *     .. Executable Statements ..
  137: *
  138:       IF( N.GT.0 ) THEN
  139:          DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
  140:             ABSXI = ABS( X( IX ) )
  141:             IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN
  142:                IF( SCALE.LT.ABSXI ) THEN
  143:                   SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
  144:                   SCALE = ABSXI
  145:                ELSE
  146:                   SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
  147:                END IF
  148:             END IF
  149:    10    CONTINUE
  150:       END IF
  151:       RETURN
  152: *
  153: *     End of DLASSQ
  154: *
  155:       END