![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLARRA 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLARRA + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarra.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarra.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarra.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM, 00022 * NSPLIT, ISPLIT, INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * INTEGER INFO, N, NSPLIT 00026 * REAL SPLTOL, TNRM 00027 * .. 00028 * .. Array Arguments .. 00029 * INTEGER ISPLIT( * ) 00030 * REAL D( * ), E( * ), E2( * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> Compute the splitting points with threshold SPLTOL. 00040 *> SLARRA sets any "small" off-diagonal elements to zero. 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[in] N 00047 *> \verbatim 00048 *> N is INTEGER 00049 *> The order of the matrix. N > 0. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] D 00053 *> \verbatim 00054 *> D is REAL array, dimension (N) 00055 *> On entry, the N diagonal elements of the tridiagonal 00056 *> matrix T. 00057 *> \endverbatim 00058 *> 00059 *> \param[in,out] E 00060 *> \verbatim 00061 *> E is REAL array, dimension (N) 00062 *> On entry, the first (N-1) entries contain the subdiagonal 00063 *> elements of the tridiagonal matrix T; E(N) need not be set. 00064 *> On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT, 00065 *> are set to zero, the other entries of E are untouched. 00066 *> \endverbatim 00067 *> 00068 *> \param[in,out] E2 00069 *> \verbatim 00070 *> E2 is REAL array, dimension (N) 00071 *> On entry, the first (N-1) entries contain the SQUARES of the 00072 *> subdiagonal elements of the tridiagonal matrix T; 00073 *> E2(N) need not be set. 00074 *> On exit, the entries E2( ISPLIT( I ) ), 00075 *> 1 <= I <= NSPLIT, have been set to zero 00076 *> \endverbatim 00077 *> 00078 *> \param[in] SPLTOL 00079 *> \verbatim 00080 *> SPLTOL is REAL 00081 *> The threshold for splitting. Two criteria can be used: 00082 *> SPLTOL<0 : criterion based on absolute off-diagonal value 00083 *> SPLTOL>0 : criterion that preserves relative accuracy 00084 *> \endverbatim 00085 *> 00086 *> \param[in] TNRM 00087 *> \verbatim 00088 *> TNRM is REAL 00089 *> The norm of the matrix. 00090 *> \endverbatim 00091 *> 00092 *> \param[out] NSPLIT 00093 *> \verbatim 00094 *> NSPLIT is INTEGER 00095 *> The number of blocks T splits into. 1 <= NSPLIT <= N. 00096 *> \endverbatim 00097 *> 00098 *> \param[out] ISPLIT 00099 *> \verbatim 00100 *> ISPLIT is INTEGER array, dimension (N) 00101 *> The splitting points, at which T breaks up into blocks. 00102 *> The first block consists of rows/columns 1 to ISPLIT(1), 00103 *> the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), 00104 *> etc., and the NSPLIT-th consists of rows/columns 00105 *> ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. 00106 *> \endverbatim 00107 *> 00108 *> \param[out] INFO 00109 *> \verbatim 00110 *> INFO is INTEGER 00111 *> = 0: successful exit 00112 *> \endverbatim 00113 * 00114 * Authors: 00115 * ======== 00116 * 00117 *> \author Univ. of Tennessee 00118 *> \author Univ. of California Berkeley 00119 *> \author Univ. of Colorado Denver 00120 *> \author NAG Ltd. 00121 * 00122 *> \date November 2011 00123 * 00124 *> \ingroup auxOTHERauxiliary 00125 * 00126 *> \par Contributors: 00127 * ================== 00128 *> 00129 *> Beresford Parlett, University of California, Berkeley, USA \n 00130 *> Jim Demmel, University of California, Berkeley, USA \n 00131 *> Inderjit Dhillon, University of Texas, Austin, USA \n 00132 *> Osni Marques, LBNL/NERSC, USA \n 00133 *> Christof Voemel, University of California, Berkeley, USA 00134 * 00135 * ===================================================================== 00136 SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM, 00137 $ NSPLIT, ISPLIT, INFO ) 00138 * 00139 * -- LAPACK auxiliary routine (version 3.4.0) -- 00140 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00141 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00142 * November 2011 00143 * 00144 * .. Scalar Arguments .. 00145 INTEGER INFO, N, NSPLIT 00146 REAL SPLTOL, TNRM 00147 * .. 00148 * .. Array Arguments .. 00149 INTEGER ISPLIT( * ) 00150 REAL D( * ), E( * ), E2( * ) 00151 * .. 00152 * 00153 * ===================================================================== 00154 * 00155 * .. Parameters .. 00156 REAL ZERO 00157 PARAMETER ( ZERO = 0.0E0 ) 00158 * .. 00159 * .. Local Scalars .. 00160 INTEGER I 00161 REAL EABS, TMP1 00162 00163 * .. 00164 * .. Intrinsic Functions .. 00165 INTRINSIC ABS 00166 * .. 00167 * .. Executable Statements .. 00168 * 00169 INFO = 0 00170 00171 * Compute splitting points 00172 NSPLIT = 1 00173 IF(SPLTOL.LT.ZERO) THEN 00174 * Criterion based on absolute off-diagonal value 00175 TMP1 = ABS(SPLTOL)* TNRM 00176 DO 9 I = 1, N-1 00177 EABS = ABS( E(I) ) 00178 IF( EABS .LE. TMP1) THEN 00179 E(I) = ZERO 00180 E2(I) = ZERO 00181 ISPLIT( NSPLIT ) = I 00182 NSPLIT = NSPLIT + 1 00183 END IF 00184 9 CONTINUE 00185 ELSE 00186 * Criterion that guarantees relative accuracy 00187 DO 10 I = 1, N-1 00188 EABS = ABS( E(I) ) 00189 IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) ) 00190 $ THEN 00191 E(I) = ZERO 00192 E2(I) = ZERO 00193 ISPLIT( NSPLIT ) = I 00194 NSPLIT = NSPLIT + 1 00195 END IF 00196 10 CONTINUE 00197 ENDIF 00198 ISPLIT( NSPLIT ) = N 00199 00200 RETURN 00201 * 00202 * End of SLARRA 00203 * 00204 END