Annotation of rpl/lapack/lapack/zlassq.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b ZLASSQ
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download ZLASSQ + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlassq.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlassq.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlassq.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
! 22: *
! 23: * .. Scalar Arguments ..
! 24: * INTEGER INCX, N
! 25: * DOUBLE PRECISION SCALE, SUMSQ
! 26: * ..
! 27: * .. Array Arguments ..
! 28: * COMPLEX*16 X( * )
! 29: * ..
! 30: *
! 31: *
! 32: *> \par Purpose:
! 33: * =============
! 34: *>
! 35: *> \verbatim
! 36: *>
! 37: *> ZLASSQ returns the values scl and ssq such that
! 38: *>
! 39: *> ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
! 40: *>
! 41: *> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
! 42: *> assumed to be at least unity and the value of ssq will then satisfy
! 43: *>
! 44: *> 1.0 .le. ssq .le. ( sumsq + 2*n ).
! 45: *>
! 46: *> scale is assumed to be non-negative and scl returns the value
! 47: *>
! 48: *> scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
! 49: *> i
! 50: *>
! 51: *> scale and sumsq must be supplied in SCALE and SUMSQ respectively.
! 52: *> SCALE and SUMSQ are overwritten by scl and ssq respectively.
! 53: *>
! 54: *> The routine makes only one pass through the vector X.
! 55: *> \endverbatim
! 56: *
! 57: * Arguments:
! 58: * ==========
! 59: *
! 60: *> \param[in] N
! 61: *> \verbatim
! 62: *> N is INTEGER
! 63: *> The number of elements to be used from the vector X.
! 64: *> \endverbatim
! 65: *>
! 66: *> \param[in] X
! 67: *> \verbatim
! 68: *> X is COMPLEX*16 array, dimension (N)
! 69: *> The vector x as described above.
! 70: *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
! 71: *> \endverbatim
! 72: *>
! 73: *> \param[in] INCX
! 74: *> \verbatim
! 75: *> INCX is INTEGER
! 76: *> The increment between successive values of the vector X.
! 77: *> INCX > 0.
! 78: *> \endverbatim
! 79: *>
! 80: *> \param[in,out] SCALE
! 81: *> \verbatim
! 82: *> SCALE is DOUBLE PRECISION
! 83: *> On entry, the value scale in the equation above.
! 84: *> On exit, SCALE is overwritten with the value scl .
! 85: *> \endverbatim
! 86: *>
! 87: *> \param[in,out] SUMSQ
! 88: *> \verbatim
! 89: *> SUMSQ is DOUBLE PRECISION
! 90: *> On entry, the value sumsq in the equation above.
! 91: *> On exit, SUMSQ is overwritten with the value ssq .
! 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: * =====================================================================
1.1 bertrand 107: SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
108: *
1.8 ! bertrand 109: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 110: * -- LAPACK is a software package provided by Univ. of Tennessee, --
111: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 112: * November 2011
1.1 bertrand 113: *
114: * .. Scalar Arguments ..
115: INTEGER INCX, N
116: DOUBLE PRECISION SCALE, SUMSQ
117: * ..
118: * .. Array Arguments ..
119: COMPLEX*16 X( * )
120: * ..
121: *
122: * =====================================================================
123: *
124: * .. Parameters ..
125: DOUBLE PRECISION ZERO
126: PARAMETER ( ZERO = 0.0D+0 )
127: * ..
128: * .. Local Scalars ..
129: INTEGER IX
130: DOUBLE PRECISION TEMP1
131: * ..
132: * .. Intrinsic Functions ..
133: INTRINSIC ABS, DBLE, DIMAG
134: * ..
135: * .. Executable Statements ..
136: *
137: IF( N.GT.0 ) THEN
138: DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
139: IF( DBLE( X( IX ) ).NE.ZERO ) THEN
140: TEMP1 = ABS( DBLE( X( IX ) ) )
141: IF( SCALE.LT.TEMP1 ) THEN
142: SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
143: SCALE = TEMP1
144: ELSE
145: SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
146: END IF
147: END IF
148: IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
149: TEMP1 = ABS( DIMAG( X( IX ) ) )
150: IF( SCALE.LT.TEMP1 ) THEN
151: SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
152: SCALE = TEMP1
153: ELSE
154: SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
155: END IF
156: END IF
157: 10 CONTINUE
158: END IF
159: *
160: RETURN
161: *
162: * End of ZLASSQ
163: *
164: END
CVSweb interface <joel.bertrand@systella.fr>