Return to zlassq.f CVS log

Up to [local] / rpl / lapack / lapack

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