![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLASSQ 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLASSQ + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/classq.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/classq.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/classq.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CLASSQ( N, X, INCX, SCALE, SUMSQ ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INCX, N 00025 * REAL SCALE, SUMSQ 00026 * .. 00027 * .. Array Arguments .. 00028 * COMPLEX X( * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> CLASSQ 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 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 REAL 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 REAL 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 complexOTHERauxiliary 00105 * 00106 * ===================================================================== 00107 SUBROUTINE CLASSQ( 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 REAL SCALE, SUMSQ 00117 * .. 00118 * .. Array Arguments .. 00119 COMPLEX X( * ) 00120 * .. 00121 * 00122 * ===================================================================== 00123 * 00124 * .. Parameters .. 00125 REAL ZERO 00126 PARAMETER ( ZERO = 0.0E+0 ) 00127 * .. 00128 * .. Local Scalars .. 00129 INTEGER IX 00130 REAL TEMP1 00131 * .. 00132 * .. Intrinsic Functions .. 00133 INTRINSIC ABS, AIMAG, REAL 00134 * .. 00135 * .. Executable Statements .. 00136 * 00137 IF( N.GT.0 ) THEN 00138 DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX 00139 IF( REAL( X( IX ) ).NE.ZERO ) THEN 00140 TEMP1 = ABS( REAL( 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( AIMAG( X( IX ) ).NE.ZERO ) THEN 00149 TEMP1 = ABS( AIMAG( 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 CLASSQ 00163 * 00164 END