00001 /* dlarrr.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 dlarrr_(integer *n, doublereal *d__, doublereal *e, 00017 integer *info) 00018 { 00019 /* System generated locals */ 00020 integer i__1; 00021 doublereal d__1; 00022 00023 /* Builtin functions */ 00024 double sqrt(doublereal); 00025 00026 /* Local variables */ 00027 integer i__; 00028 doublereal eps, tmp, tmp2, rmin; 00029 extern doublereal dlamch_(char *); 00030 doublereal offdig, safmin; 00031 logical yesrel; 00032 doublereal smlnum, offdig2; 00033 00034 00035 /* -- LAPACK auxiliary routine (version 3.2) -- */ 00036 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00037 /* November 2006 */ 00038 00039 /* .. Scalar Arguments .. */ 00040 /* .. */ 00041 /* .. Array Arguments .. */ 00042 /* .. */ 00043 00044 00045 /* Purpose */ 00046 /* ======= */ 00047 00048 /* Perform tests to decide whether the symmetric tridiagonal matrix T */ 00049 /* warrants expensive computations which guarantee high relative accuracy */ 00050 /* in the eigenvalues. */ 00051 00052 /* Arguments */ 00053 /* ========= */ 00054 00055 /* N (input) INTEGER */ 00056 /* The order of the matrix. N > 0. */ 00057 00058 /* D (input) DOUBLE PRECISION array, dimension (N) */ 00059 /* The N diagonal elements of the tridiagonal matrix T. */ 00060 00061 /* E (input/output) DOUBLE PRECISION array, dimension (N) */ 00062 /* On entry, the first (N-1) entries contain the subdiagonal */ 00063 /* elements of the tridiagonal matrix T; E(N) is set to ZERO. */ 00064 00065 /* INFO (output) INTEGER */ 00066 /* INFO = 0(default) : the matrix warrants computations preserving */ 00067 /* relative accuracy. */ 00068 /* INFO = 1 : the matrix warrants computations guaranteeing */ 00069 /* only absolute accuracy. */ 00070 00071 /* Further Details */ 00072 /* =============== */ 00073 00074 /* Based on contributions by */ 00075 /* Beresford Parlett, University of California, Berkeley, USA */ 00076 /* Jim Demmel, University of California, Berkeley, USA */ 00077 /* Inderjit Dhillon, University of Texas, Austin, USA */ 00078 /* Osni Marques, LBNL/NERSC, USA */ 00079 /* Christof Voemel, University of California, Berkeley, USA */ 00080 00081 /* ===================================================================== */ 00082 00083 /* .. Parameters .. */ 00084 /* .. */ 00085 /* .. Local Scalars .. */ 00086 /* .. */ 00087 /* .. External Functions .. */ 00088 /* .. */ 00089 /* .. Intrinsic Functions .. */ 00090 /* .. */ 00091 /* .. Executable Statements .. */ 00092 00093 /* As a default, do NOT go for relative-accuracy preserving computations. */ 00094 /* Parameter adjustments */ 00095 --e; 00096 --d__; 00097 00098 /* Function Body */ 00099 *info = 1; 00100 safmin = dlamch_("Safe minimum"); 00101 eps = dlamch_("Precision"); 00102 smlnum = safmin / eps; 00103 rmin = sqrt(smlnum); 00104 /* Tests for relative accuracy */ 00105 00106 /* Test for scaled diagonal dominance */ 00107 /* Scale the diagonal entries to one and check whether the sum of the */ 00108 /* off-diagonals is less than one */ 00109 00110 /* The sdd relative error bounds have a 1/(1- 2*x) factor in them, */ 00111 /* x = max(OFFDIG + OFFDIG2), so when x is close to 1/2, no relative */ 00112 /* accuracy is promised. In the notation of the code fragment below, */ 00113 /* 1/(1 - (OFFDIG + OFFDIG2)) is the condition number. */ 00114 /* We don't think it is worth going into "sdd mode" unless the relative */ 00115 /* condition number is reasonable, not 1/macheps. */ 00116 /* The threshold should be compatible with other thresholds used in the */ 00117 /* code. We set OFFDIG + OFFDIG2 <= .999 =: RELCOND, it corresponds */ 00118 /* to losing at most 3 decimal digits: 1 / (1 - (OFFDIG + OFFDIG2)) <= 1000 */ 00119 /* instead of the current OFFDIG + OFFDIG2 < 1 */ 00120 00121 yesrel = TRUE_; 00122 offdig = 0.; 00123 tmp = sqrt((abs(d__[1]))); 00124 if (tmp < rmin) { 00125 yesrel = FALSE_; 00126 } 00127 if (! yesrel) { 00128 goto L11; 00129 } 00130 i__1 = *n; 00131 for (i__ = 2; i__ <= i__1; ++i__) { 00132 tmp2 = sqrt((d__1 = d__[i__], abs(d__1))); 00133 if (tmp2 < rmin) { 00134 yesrel = FALSE_; 00135 } 00136 if (! yesrel) { 00137 goto L11; 00138 } 00139 offdig2 = (d__1 = e[i__ - 1], abs(d__1)) / (tmp * tmp2); 00140 if (offdig + offdig2 >= .999) { 00141 yesrel = FALSE_; 00142 } 00143 if (! yesrel) { 00144 goto L11; 00145 } 00146 tmp = tmp2; 00147 offdig = offdig2; 00148 /* L10: */ 00149 } 00150 L11: 00151 if (yesrel) { 00152 *info = 0; 00153 return 0; 00154 } else { 00155 } 00156 00157 00158 /* *** MORE TO BE IMPLEMENTED *** */ 00159 00160 00161 /* Test if the lower bidiagonal matrix L from T = L D L^T */ 00162 /* (zero shift facto) is well conditioned */ 00163 00164 00165 /* Test if the upper bidiagonal matrix U from T = U D U^T */ 00166 /* (zero shift facto) is well conditioned. */ 00167 /* In this case, the matrix needs to be flipped and, at the end */ 00168 /* of the eigenvector computation, the flip needs to be applied */ 00169 /* to the computed eigenvectors (and the support) */ 00170 00171 00172 return 0; 00173 00174 /* END OF DLARRR */ 00175 00176 } /* dlarrr_ */