![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CPPEQU 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CPPEQU + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cppequ.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cppequ.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cppequ.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER UPLO 00025 * INTEGER INFO, N 00026 * REAL AMAX, SCOND 00027 * .. 00028 * .. Array Arguments .. 00029 * REAL S( * ) 00030 * COMPLEX AP( * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> CPPEQU computes row and column scalings intended to equilibrate a 00040 *> Hermitian positive definite matrix A in packed storage and reduce 00041 *> its condition number (with respect to the two-norm). S contains the 00042 *> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix 00043 *> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal. 00044 *> This choice of S puts the condition number of B within a factor N of 00045 *> the smallest possible condition number over all possible diagonal 00046 *> scalings. 00047 *> \endverbatim 00048 * 00049 * Arguments: 00050 * ========== 00051 * 00052 *> \param[in] UPLO 00053 *> \verbatim 00054 *> UPLO is CHARACTER*1 00055 *> = 'U': Upper triangle of A is stored; 00056 *> = 'L': Lower triangle of A is stored. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] N 00060 *> \verbatim 00061 *> N is INTEGER 00062 *> The order of the matrix A. N >= 0. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] AP 00066 *> \verbatim 00067 *> AP is COMPLEX array, dimension (N*(N+1)/2) 00068 *> The upper or lower triangle of the Hermitian matrix A, packed 00069 *> columnwise in a linear array. The j-th column of A is stored 00070 *> in the array AP as follows: 00071 *> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; 00072 *> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n. 00073 *> \endverbatim 00074 *> 00075 *> \param[out] S 00076 *> \verbatim 00077 *> S is REAL array, dimension (N) 00078 *> If INFO = 0, S contains the scale factors for A. 00079 *> \endverbatim 00080 *> 00081 *> \param[out] SCOND 00082 *> \verbatim 00083 *> SCOND is REAL 00084 *> If INFO = 0, S contains the ratio of the smallest S(i) to 00085 *> the largest S(i). If SCOND >= 0.1 and AMAX is neither too 00086 *> large nor too small, it is not worth scaling by S. 00087 *> \endverbatim 00088 *> 00089 *> \param[out] AMAX 00090 *> \verbatim 00091 *> AMAX is REAL 00092 *> Absolute value of largest matrix element. If AMAX is very 00093 *> close to overflow or very close to underflow, the matrix 00094 *> should be scaled. 00095 *> \endverbatim 00096 *> 00097 *> \param[out] INFO 00098 *> \verbatim 00099 *> INFO is INTEGER 00100 *> = 0: successful exit 00101 *> < 0: if INFO = -i, the i-th argument had an illegal value 00102 *> > 0: if INFO = i, the i-th diagonal element is nonpositive. 00103 *> \endverbatim 00104 * 00105 * Authors: 00106 * ======== 00107 * 00108 *> \author Univ. of Tennessee 00109 *> \author Univ. of California Berkeley 00110 *> \author Univ. of Colorado Denver 00111 *> \author NAG Ltd. 00112 * 00113 *> \date November 2011 00114 * 00115 *> \ingroup complexOTHERcomputational 00116 * 00117 * ===================================================================== 00118 SUBROUTINE CPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO ) 00119 * 00120 * -- LAPACK computational routine (version 3.4.0) -- 00121 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00122 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00123 * November 2011 00124 * 00125 * .. Scalar Arguments .. 00126 CHARACTER UPLO 00127 INTEGER INFO, N 00128 REAL AMAX, SCOND 00129 * .. 00130 * .. Array Arguments .. 00131 REAL S( * ) 00132 COMPLEX AP( * ) 00133 * .. 00134 * 00135 * ===================================================================== 00136 * 00137 * .. Parameters .. 00138 REAL ONE, ZERO 00139 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00140 * .. 00141 * .. Local Scalars .. 00142 LOGICAL UPPER 00143 INTEGER I, JJ 00144 REAL SMIN 00145 * .. 00146 * .. External Functions .. 00147 LOGICAL LSAME 00148 EXTERNAL LSAME 00149 * .. 00150 * .. External Subroutines .. 00151 EXTERNAL XERBLA 00152 * .. 00153 * .. Intrinsic Functions .. 00154 INTRINSIC MAX, MIN, REAL, SQRT 00155 * .. 00156 * .. Executable Statements .. 00157 * 00158 * Test the input parameters. 00159 * 00160 INFO = 0 00161 UPPER = LSAME( UPLO, 'U' ) 00162 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00163 INFO = -1 00164 ELSE IF( N.LT.0 ) THEN 00165 INFO = -2 00166 END IF 00167 IF( INFO.NE.0 ) THEN 00168 CALL XERBLA( 'CPPEQU', -INFO ) 00169 RETURN 00170 END IF 00171 * 00172 * Quick return if possible 00173 * 00174 IF( N.EQ.0 ) THEN 00175 SCOND = ONE 00176 AMAX = ZERO 00177 RETURN 00178 END IF 00179 * 00180 * Initialize SMIN and AMAX. 00181 * 00182 S( 1 ) = REAL( AP( 1 ) ) 00183 SMIN = S( 1 ) 00184 AMAX = S( 1 ) 00185 * 00186 IF( UPPER ) THEN 00187 * 00188 * UPLO = 'U': Upper triangle of A is stored. 00189 * Find the minimum and maximum diagonal elements. 00190 * 00191 JJ = 1 00192 DO 10 I = 2, N 00193 JJ = JJ + I 00194 S( I ) = REAL( AP( JJ ) ) 00195 SMIN = MIN( SMIN, S( I ) ) 00196 AMAX = MAX( AMAX, S( I ) ) 00197 10 CONTINUE 00198 * 00199 ELSE 00200 * 00201 * UPLO = 'L': Lower triangle of A is stored. 00202 * Find the minimum and maximum diagonal elements. 00203 * 00204 JJ = 1 00205 DO 20 I = 2, N 00206 JJ = JJ + N - I + 2 00207 S( I ) = REAL( AP( JJ ) ) 00208 SMIN = MIN( SMIN, S( I ) ) 00209 AMAX = MAX( AMAX, S( I ) ) 00210 20 CONTINUE 00211 END IF 00212 * 00213 IF( SMIN.LE.ZERO ) THEN 00214 * 00215 * Find the first non-positive diagonal element and return. 00216 * 00217 DO 30 I = 1, N 00218 IF( S( I ).LE.ZERO ) THEN 00219 INFO = I 00220 RETURN 00221 END IF 00222 30 CONTINUE 00223 ELSE 00224 * 00225 * Set the scale factors to the reciprocals 00226 * of the diagonal elements. 00227 * 00228 DO 40 I = 1, N 00229 S( I ) = ONE / SQRT( S( I ) ) 00230 40 CONTINUE 00231 * 00232 * Compute SCOND = min(S(I)) / max(S(I)) 00233 * 00234 SCOND = SQRT( SMIN ) / SQRT( AMAX ) 00235 END IF 00236 RETURN 00237 * 00238 * End of CPPEQU 00239 * 00240 END