LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlassq.f
Go to the documentation of this file.
00001 *> \brief \b ZLASSQ
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZLASSQ + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlassq.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlassq.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlassq.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INCX, N
00025 *       DOUBLE PRECISION   SCALE, SUMSQ
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       COMPLEX*16         X( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> ZLASSQ returns the values scl and ssq such that
00038 *>
00039 *>    ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
00040 *>
00041 *> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
00042 *> assumed to be at least unity and the value of ssq will then satisfy
00043 *>
00044 *>    1.0 .le. ssq .le. ( sumsq + 2*n ).
00045 *>
00046 *> scale is assumed to be non-negative and scl returns the value
00047 *>
00048 *>    scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
00049 *>           i
00050 *>
00051 *> scale and sumsq must be supplied in SCALE and SUMSQ respectively.
00052 *> SCALE and SUMSQ are overwritten by scl and ssq respectively.
00053 *>
00054 *> The routine makes only one pass through the vector X.
00055 *> \endverbatim
00056 *
00057 *  Arguments:
00058 *  ==========
00059 *
00060 *> \param[in] N
00061 *> \verbatim
00062 *>          N is INTEGER
00063 *>          The number of elements to be used from the vector X.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] X
00067 *> \verbatim
00068 *>          X is COMPLEX*16 array, dimension (N)
00069 *>          The vector x as described above.
00070 *>             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
00071 *> \endverbatim
00072 *>
00073 *> \param[in] INCX
00074 *> \verbatim
00075 *>          INCX is INTEGER
00076 *>          The increment between successive values of the vector X.
00077 *>          INCX > 0.
00078 *> \endverbatim
00079 *>
00080 *> \param[in,out] SCALE
00081 *> \verbatim
00082 *>          SCALE is DOUBLE PRECISION
00083 *>          On entry, the value  scale  in the equation above.
00084 *>          On exit, SCALE is overwritten with the value  scl .
00085 *> \endverbatim
00086 *>
00087 *> \param[in,out] SUMSQ
00088 *> \verbatim
00089 *>          SUMSQ is DOUBLE PRECISION
00090 *>          On entry, the value  sumsq  in the equation above.
00091 *>          On exit, SUMSQ is overwritten with the value  ssq .
00092 *> \endverbatim
00093 *
00094 *  Authors:
00095 *  ========
00096 *
00097 *> \author Univ. of Tennessee 
00098 *> \author Univ. of California Berkeley 
00099 *> \author Univ. of Colorado Denver 
00100 *> \author NAG Ltd. 
00101 *
00102 *> \date November 2011
00103 *
00104 *> \ingroup complex16OTHERauxiliary
00105 *
00106 *  =====================================================================
00107       SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
00108 *
00109 *  -- LAPACK auxiliary routine (version 3.4.0) --
00110 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00111 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00112 *     November 2011
00113 *
00114 *     .. Scalar Arguments ..
00115       INTEGER            INCX, N
00116       DOUBLE PRECISION   SCALE, SUMSQ
00117 *     ..
00118 *     .. Array Arguments ..
00119       COMPLEX*16         X( * )
00120 *     ..
00121 *
00122 * =====================================================================
00123 *
00124 *     .. Parameters ..
00125       DOUBLE PRECISION   ZERO
00126       PARAMETER          ( ZERO = 0.0D+0 )
00127 *     ..
00128 *     .. Local Scalars ..
00129       INTEGER            IX
00130       DOUBLE PRECISION   TEMP1
00131 *     ..
00132 *     .. Intrinsic Functions ..
00133       INTRINSIC          ABS, DBLE, DIMAG
00134 *     ..
00135 *     .. Executable Statements ..
00136 *
00137       IF( N.GT.0 ) THEN
00138          DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
00139             IF( DBLE( X( IX ) ).NE.ZERO ) THEN
00140                TEMP1 = ABS( DBLE( X( IX ) ) )
00141                IF( SCALE.LT.TEMP1 ) THEN
00142                   SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
00143                   SCALE = TEMP1
00144                ELSE
00145                   SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
00146                END IF
00147             END IF
00148             IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
00149                TEMP1 = ABS( DIMAG( X( IX ) ) )
00150                IF( SCALE.LT.TEMP1 ) THEN
00151                   SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
00152                   SCALE = TEMP1
00153                ELSE
00154                   SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
00155                END IF
00156             END IF
00157    10    CONTINUE
00158       END IF
00159 *
00160       RETURN
00161 *
00162 *     End of ZLASSQ
00163 *
00164       END
 All Files Functions