|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM, 00002 $ NSPLIT, ISPLIT, INFO ) 00003 IMPLICIT NONE 00004 * 00005 * -- LAPACK auxiliary routine (version 3.2) -- 00006 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00007 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00008 * November 2006 00009 * 00010 * .. Scalar Arguments .. 00011 INTEGER INFO, N, NSPLIT 00012 REAL SPLTOL, TNRM 00013 * .. 00014 * .. Array Arguments .. 00015 INTEGER ISPLIT( * ) 00016 REAL D( * ), E( * ), E2( * ) 00017 * .. 00018 * 00019 * Purpose 00020 * ======= 00021 * 00022 * Compute the splitting points with threshold SPLTOL. 00023 * SLARRA sets any "small" off-diagonal elements to zero. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * N (input) INTEGER 00029 * The order of the matrix. N > 0. 00030 * 00031 * D (input) REAL array, dimension (N) 00032 * On entry, the N diagonal elements of the tridiagonal 00033 * matrix T. 00034 * 00035 * E (input/output) REAL array, dimension (N) 00036 * On entry, the first (N-1) entries contain the subdiagonal 00037 * elements of the tridiagonal matrix T; E(N) need not be set. 00038 * On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT, 00039 * are set to zero, the other entries of E are untouched. 00040 * 00041 * E2 (input/output) REAL array, dimension (N) 00042 * On entry, the first (N-1) entries contain the SQUARES of the 00043 * subdiagonal elements of the tridiagonal matrix T; 00044 * E2(N) need not be set. 00045 * On exit, the entries E2( ISPLIT( I ) ), 00046 * 1 <= I <= NSPLIT, have been set to zero 00047 * 00048 * SPLTOL (input) REAL 00049 * The threshold for splitting. Two criteria can be used: 00050 * SPLTOL<0 : criterion based on absolute off-diagonal value 00051 * SPLTOL>0 : criterion that preserves relative accuracy 00052 * 00053 * TNRM (input) REAL 00054 * The norm of the matrix. 00055 * 00056 * NSPLIT (output) INTEGER 00057 * The number of blocks T splits into. 1 <= NSPLIT <= N. 00058 * 00059 * ISPLIT (output) INTEGER array, dimension (N) 00060 * The splitting points, at which T breaks up into blocks. 00061 * The first block consists of rows/columns 1 to ISPLIT(1), 00062 * the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), 00063 * etc., and the NSPLIT-th consists of rows/columns 00064 * ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. 00065 * 00066 * 00067 * INFO (output) INTEGER 00068 * = 0: successful exit 00069 * 00070 * Further Details 00071 * =============== 00072 * 00073 * Based on contributions by 00074 * Beresford Parlett, University of California, Berkeley, USA 00075 * Jim Demmel, University of California, Berkeley, USA 00076 * Inderjit Dhillon, University of Texas, Austin, USA 00077 * Osni Marques, LBNL/NERSC, USA 00078 * Christof Voemel, University of California, Berkeley, USA 00079 * 00080 * ===================================================================== 00081 * 00082 * .. Parameters .. 00083 REAL ZERO 00084 PARAMETER ( ZERO = 0.0E0 ) 00085 * .. 00086 * .. Local Scalars .. 00087 INTEGER I 00088 REAL EABS, TMP1 00089 00090 * .. 00091 * .. Intrinsic Functions .. 00092 INTRINSIC ABS 00093 * .. 00094 * .. Executable Statements .. 00095 * 00096 INFO = 0 00097 00098 * Compute splitting points 00099 NSPLIT = 1 00100 IF(SPLTOL.LT.ZERO) THEN 00101 * Criterion based on absolute off-diagonal value 00102 TMP1 = ABS(SPLTOL)* TNRM 00103 DO 9 I = 1, N-1 00104 EABS = ABS( E(I) ) 00105 IF( EABS .LE. TMP1) THEN 00106 E(I) = ZERO 00107 E2(I) = ZERO 00108 ISPLIT( NSPLIT ) = I 00109 NSPLIT = NSPLIT + 1 00110 END IF 00111 9 CONTINUE 00112 ELSE 00113 * Criterion that guarantees relative accuracy 00114 DO 10 I = 1, N-1 00115 EABS = ABS( E(I) ) 00116 IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) ) 00117 $ THEN 00118 E(I) = ZERO 00119 E2(I) = ZERO 00120 ISPLIT( NSPLIT ) = I 00121 NSPLIT = NSPLIT + 1 00122 END IF 00123 10 CONTINUE 00124 ENDIF 00125 ISPLIT( NSPLIT ) = N 00126 00127 RETURN 00128 * 00129 * End of SLARRA 00130 * 00131 END
1.7.3 
