![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLARRR 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLARRR + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarrr.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarrr.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarrr.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLARRR( N, D, E, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER N, INFO 00025 * .. 00026 * .. Array Arguments .. 00027 * REAL D( * ), E( * ) 00028 * .. 00029 * 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> Perform tests to decide whether the symmetric tridiagonal matrix T 00038 *> warrants expensive computations which guarantee high relative accuracy 00039 *> in the eigenvalues. 00040 *> \endverbatim 00041 * 00042 * Arguments: 00043 * ========== 00044 * 00045 *> \param[in] N 00046 *> \verbatim 00047 *> N is INTEGER 00048 *> The order of the matrix. N > 0. 00049 *> \endverbatim 00050 *> 00051 *> \param[in] D 00052 *> \verbatim 00053 *> D is REAL array, dimension (N) 00054 *> The N diagonal elements of the tridiagonal matrix T. 00055 *> \endverbatim 00056 *> 00057 *> \param[in,out] E 00058 *> \verbatim 00059 *> E is REAL array, dimension (N) 00060 *> On entry, the first (N-1) entries contain the subdiagonal 00061 *> elements of the tridiagonal matrix T; E(N) is set to ZERO. 00062 *> \endverbatim 00063 *> 00064 *> \param[out] INFO 00065 *> \verbatim 00066 *> INFO is INTEGER 00067 *> INFO = 0(default) : the matrix warrants computations preserving 00068 *> relative accuracy. 00069 *> INFO = 1 : the matrix warrants computations guaranteeing 00070 *> only absolute accuracy. 00071 *> \endverbatim 00072 * 00073 * Authors: 00074 * ======== 00075 * 00076 *> \author Univ. of Tennessee 00077 *> \author Univ. of California Berkeley 00078 *> \author Univ. of Colorado Denver 00079 *> \author NAG Ltd. 00080 * 00081 *> \date November 2011 00082 * 00083 *> \ingroup auxOTHERauxiliary 00084 * 00085 *> \par Contributors: 00086 * ================== 00087 *> 00088 *> Beresford Parlett, University of California, Berkeley, USA \n 00089 *> Jim Demmel, University of California, Berkeley, USA \n 00090 *> Inderjit Dhillon, University of Texas, Austin, USA \n 00091 *> Osni Marques, LBNL/NERSC, USA \n 00092 *> Christof Voemel, University of California, Berkeley, USA 00093 * 00094 * ===================================================================== 00095 SUBROUTINE SLARRR( N, D, E, INFO ) 00096 * 00097 * -- LAPACK auxiliary routine (version 3.4.0) -- 00098 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00099 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00100 * November 2011 00101 * 00102 * .. Scalar Arguments .. 00103 INTEGER N, INFO 00104 * .. 00105 * .. Array Arguments .. 00106 REAL D( * ), E( * ) 00107 * .. 00108 * 00109 * 00110 * ===================================================================== 00111 * 00112 * .. Parameters .. 00113 REAL ZERO, RELCOND 00114 PARAMETER ( ZERO = 0.0E0, 00115 $ RELCOND = 0.999E0 ) 00116 * .. 00117 * .. Local Scalars .. 00118 INTEGER I 00119 LOGICAL YESREL 00120 REAL EPS, SAFMIN, SMLNUM, RMIN, TMP, TMP2, 00121 $ OFFDIG, OFFDIG2 00122 00123 * .. 00124 * .. External Functions .. 00125 REAL SLAMCH 00126 EXTERNAL SLAMCH 00127 * .. 00128 * .. Intrinsic Functions .. 00129 INTRINSIC ABS 00130 * .. 00131 * .. Executable Statements .. 00132 * 00133 * As a default, do NOT go for relative-accuracy preserving computations. 00134 INFO = 1 00135 00136 SAFMIN = SLAMCH( 'Safe minimum' ) 00137 EPS = SLAMCH( 'Precision' ) 00138 SMLNUM = SAFMIN / EPS 00139 RMIN = SQRT( SMLNUM ) 00140 00141 * Tests for relative accuracy 00142 * 00143 * Test for scaled diagonal dominance 00144 * Scale the diagonal entries to one and check whether the sum of the 00145 * off-diagonals is less than one 00146 * 00147 * The sdd relative error bounds have a 1/(1- 2*x) factor in them, 00148 * x = max(OFFDIG + OFFDIG2), so when x is close to 1/2, no relative 00149 * accuracy is promised. In the notation of the code fragment below, 00150 * 1/(1 - (OFFDIG + OFFDIG2)) is the condition number. 00151 * We don't think it is worth going into "sdd mode" unless the relative 00152 * condition number is reasonable, not 1/macheps. 00153 * The threshold should be compatible with other thresholds used in the 00154 * code. We set OFFDIG + OFFDIG2 <= .999 =: RELCOND, it corresponds 00155 * to losing at most 3 decimal digits: 1 / (1 - (OFFDIG + OFFDIG2)) <= 1000 00156 * instead of the current OFFDIG + OFFDIG2 < 1 00157 * 00158 YESREL = .TRUE. 00159 OFFDIG = ZERO 00160 TMP = SQRT(ABS(D(1))) 00161 IF (TMP.LT.RMIN) YESREL = .FALSE. 00162 IF(.NOT.YESREL) GOTO 11 00163 DO 10 I = 2, N 00164 TMP2 = SQRT(ABS(D(I))) 00165 IF (TMP2.LT.RMIN) YESREL = .FALSE. 00166 IF(.NOT.YESREL) GOTO 11 00167 OFFDIG2 = ABS(E(I-1))/(TMP*TMP2) 00168 IF(OFFDIG+OFFDIG2.GE.RELCOND) YESREL = .FALSE. 00169 IF(.NOT.YESREL) GOTO 11 00170 TMP = TMP2 00171 OFFDIG = OFFDIG2 00172 10 CONTINUE 00173 11 CONTINUE 00174 00175 IF( YESREL ) THEN 00176 INFO = 0 00177 RETURN 00178 ELSE 00179 ENDIF 00180 * 00181 00182 * 00183 * *** MORE TO BE IMPLEMENTED *** 00184 * 00185 00186 * 00187 * Test if the lower bidiagonal matrix L from T = L D L^T 00188 * (zero shift facto) is well conditioned 00189 * 00190 00191 * 00192 * Test if the upper bidiagonal matrix U from T = U D U^T 00193 * (zero shift facto) is well conditioned. 00194 * In this case, the matrix needs to be flipped and, at the end 00195 * of the eigenvector computation, the flip needs to be applied 00196 * to the computed eigenvectors (and the support) 00197 * 00198 00199 * 00200 RETURN 00201 * 00202 * END OF SLARRR 00203 * 00204 END