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