Annotation of rpl/lapack/lapack/dlassq.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b DLASSQ
! 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 (N)
! 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 November 2011
! 100: *
! 101: *> \ingroup auxOTHERauxiliary
! 102: *
! 103: * =====================================================================
1.1 bertrand 104: SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
105: *
1.8 ! bertrand 106: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 107: * -- LAPACK is a software package provided by Univ. of Tennessee, --
108: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 109: * November 2011
1.1 bertrand 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: * .. Intrinsic Functions ..
130: INTRINSIC ABS
131: * ..
132: * .. Executable Statements ..
133: *
134: IF( N.GT.0 ) THEN
135: DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
136: IF( X( IX ).NE.ZERO ) THEN
137: ABSXI = ABS( X( IX ) )
138: IF( SCALE.LT.ABSXI ) THEN
139: SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
140: SCALE = ABSXI
141: ELSE
142: SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
143: END IF
144: END IF
145: 10 CONTINUE
146: END IF
147: RETURN
148: *
149: * End of DLASSQ
150: *
151: END
CVSweb interface <joel.bertrand@systella.fr>