00001 /* dpoequ.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int dpoequ_(integer *n, doublereal *a, integer *lda, 00017 doublereal *s, doublereal *scond, doublereal *amax, integer *info) 00018 { 00019 /* System generated locals */ 00020 integer a_dim1, a_offset, i__1; 00021 doublereal d__1, d__2; 00022 00023 /* Builtin functions */ 00024 double sqrt(doublereal); 00025 00026 /* Local variables */ 00027 integer i__; 00028 doublereal smin; 00029 extern /* Subroutine */ int xerbla_(char *, integer *); 00030 00031 00032 /* -- LAPACK routine (version 3.2) -- */ 00033 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00034 /* November 2006 */ 00035 00036 /* .. Scalar Arguments .. */ 00037 /* .. */ 00038 /* .. Array Arguments .. */ 00039 /* .. */ 00040 00041 /* Purpose */ 00042 /* ======= */ 00043 00044 /* DPOEQU computes row and column scalings intended to equilibrate a */ 00045 /* symmetric positive definite matrix A and reduce its condition number */ 00046 /* (with respect to the two-norm). S contains the scale factors, */ 00047 /* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with */ 00048 /* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This */ 00049 /* choice of S puts the condition number of B within a factor N of the */ 00050 /* smallest possible condition number over all possible diagonal */ 00051 /* scalings. */ 00052 00053 /* Arguments */ 00054 /* ========= */ 00055 00056 /* N (input) INTEGER */ 00057 /* The order of the matrix A. N >= 0. */ 00058 00059 /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */ 00060 /* The N-by-N symmetric positive definite matrix whose scaling */ 00061 /* factors are to be computed. Only the diagonal elements of A */ 00062 /* are referenced. */ 00063 00064 /* LDA (input) INTEGER */ 00065 /* The leading dimension of the array A. LDA >= max(1,N). */ 00066 00067 /* S (output) DOUBLE PRECISION array, dimension (N) */ 00068 /* If INFO = 0, S contains the scale factors for A. */ 00069 00070 /* SCOND (output) DOUBLE PRECISION */ 00071 /* If INFO = 0, S contains the ratio of the smallest S(i) to */ 00072 /* the largest S(i). If SCOND >= 0.1 and AMAX is neither too */ 00073 /* large nor too small, it is not worth scaling by S. */ 00074 00075 /* AMAX (output) DOUBLE PRECISION */ 00076 /* Absolute value of largest matrix element. If AMAX is very */ 00077 /* close to overflow or very close to underflow, the matrix */ 00078 /* should be scaled. */ 00079 00080 /* INFO (output) INTEGER */ 00081 /* = 0: successful exit */ 00082 /* < 0: if INFO = -i, the i-th argument had an illegal value */ 00083 /* > 0: if INFO = i, the i-th diagonal element is nonpositive. */ 00084 00085 /* ===================================================================== */ 00086 00087 /* .. Parameters .. */ 00088 /* .. */ 00089 /* .. Local Scalars .. */ 00090 /* .. */ 00091 /* .. External Subroutines .. */ 00092 /* .. */ 00093 /* .. Intrinsic Functions .. */ 00094 /* .. */ 00095 /* .. Executable Statements .. */ 00096 00097 /* Test the input parameters. */ 00098 00099 /* Parameter adjustments */ 00100 a_dim1 = *lda; 00101 a_offset = 1 + a_dim1; 00102 a -= a_offset; 00103 --s; 00104 00105 /* Function Body */ 00106 *info = 0; 00107 if (*n < 0) { 00108 *info = -1; 00109 } else if (*lda < max(1,*n)) { 00110 *info = -3; 00111 } 00112 if (*info != 0) { 00113 i__1 = -(*info); 00114 xerbla_("DPOEQU", &i__1); 00115 return 0; 00116 } 00117 00118 /* Quick return if possible */ 00119 00120 if (*n == 0) { 00121 *scond = 1.; 00122 *amax = 0.; 00123 return 0; 00124 } 00125 00126 /* Find the minimum and maximum diagonal elements. */ 00127 00128 s[1] = a[a_dim1 + 1]; 00129 smin = s[1]; 00130 *amax = s[1]; 00131 i__1 = *n; 00132 for (i__ = 2; i__ <= i__1; ++i__) { 00133 s[i__] = a[i__ + i__ * a_dim1]; 00134 /* Computing MIN */ 00135 d__1 = smin, d__2 = s[i__]; 00136 smin = min(d__1,d__2); 00137 /* Computing MAX */ 00138 d__1 = *amax, d__2 = s[i__]; 00139 *amax = max(d__1,d__2); 00140 /* L10: */ 00141 } 00142 00143 if (smin <= 0.) { 00144 00145 /* Find the first non-positive diagonal element and return. */ 00146 00147 i__1 = *n; 00148 for (i__ = 1; i__ <= i__1; ++i__) { 00149 if (s[i__] <= 0.) { 00150 *info = i__; 00151 return 0; 00152 } 00153 /* L20: */ 00154 } 00155 } else { 00156 00157 /* Set the scale factors to the reciprocals */ 00158 /* of the diagonal elements. */ 00159 00160 i__1 = *n; 00161 for (i__ = 1; i__ <= i__1; ++i__) { 00162 s[i__] = 1. / sqrt(s[i__]); 00163 /* L30: */ 00164 } 00165 00166 /* Compute SCOND = min(S(I)) / max(S(I)) */ 00167 00168 *scond = sqrt(smin) / sqrt(*amax); 00169 } 00170 return 0; 00171 00172 /* End of DPOEQU */ 00173 00174 } /* dpoequ_ */