001:       SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM,
002:      $                    NSPLIT, ISPLIT, INFO )
003:       IMPLICIT NONE
004: *
005: *  -- LAPACK auxiliary routine (version 3.2) --
006: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
007: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
008: *     November 2006
009: *
010: *     .. Scalar Arguments ..
011:       INTEGER            INFO, N, NSPLIT
012:       REAL                SPLTOL, TNRM
013: *     ..
014: *     .. Array Arguments ..
015:       INTEGER            ISPLIT( * )
016:       REAL               D( * ), E( * ), E2( * )
017: *     ..
018: *
019: *  Purpose
020: *  =======
021: *
022: *  Compute the splitting points with threshold SPLTOL.
023: *  SLARRA sets any "small" off-diagonal elements to zero.
024: *
025: *  Arguments
026: *  =========
027: *
028: *  N       (input) INTEGER
029: *          The order of the matrix. N > 0.
030: *
031: *  D       (input) REAL             array, dimension (N)
032: *          On entry, the N diagonal elements of the tridiagonal
033: *          matrix T.
034: *
035: *  E       (input/output) REAL             array, dimension (N)
036: *          On entry, the first (N-1) entries contain the subdiagonal
037: *          elements of the tridiagonal matrix T; E(N) need not be set.
038: *          On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
039: *          are set to zero, the other entries of E are untouched.
040: *
041: *  E2      (input/output) REAL             array, dimension (N)
042: *          On entry, the first (N-1) entries contain the SQUARES of the
043: *          subdiagonal elements of the tridiagonal matrix T;
044: *          E2(N) need not be set.
045: *          On exit, the entries E2( ISPLIT( I ) ),
046: *          1 <= I <= NSPLIT, have been set to zero
047: *
048: *  SPLTOL (input) REAL            
049: *          The threshold for splitting. Two criteria can be used:
050: *          SPLTOL<0 : criterion based on absolute off-diagonal value
051: *          SPLTOL>0 : criterion that preserves relative accuracy
052: *
053: *  TNRM (input) REAL            
054: *          The norm of the matrix.
055: *
056: *  NSPLIT  (output) INTEGER
057: *          The number of blocks T splits into. 1 <= NSPLIT <= N.
058: *
059: *  ISPLIT  (output) INTEGER array, dimension (N)
060: *          The splitting points, at which T breaks up into blocks.
061: *          The first block consists of rows/columns 1 to ISPLIT(1),
062: *          the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
063: *          etc., and the NSPLIT-th consists of rows/columns
064: *          ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
065: *
066: *
067: *  INFO    (output) INTEGER
068: *          = 0:  successful exit
069: *
070: *  Further Details
071: *  ===============
072: *
073: *  Based on contributions by
074: *     Beresford Parlett, University of California, Berkeley, USA
075: *     Jim Demmel, University of California, Berkeley, USA
076: *     Inderjit Dhillon, University of Texas, Austin, USA
077: *     Osni Marques, LBNL/NERSC, USA
078: *     Christof Voemel, University of California, Berkeley, USA
079: *
080: *  =====================================================================
081: *
082: *     .. Parameters ..
083:       REAL               ZERO
084:       PARAMETER          ( ZERO = 0.0E0 )
085: *     ..
086: *     .. Local Scalars ..
087:       INTEGER            I
088:       REAL               EABS, TMP1
089: 
090: *     ..
091: *     .. Intrinsic Functions ..
092:       INTRINSIC          ABS
093: *     ..
094: *     .. Executable Statements ..
095: *
096:       INFO = 0
097: 
098: *     Compute splitting points
099:       NSPLIT = 1
100:       IF(SPLTOL.LT.ZERO) THEN
101: *        Criterion based on absolute off-diagonal value
102:          TMP1 = ABS(SPLTOL)* TNRM
103:          DO 9 I = 1, N-1
104:             EABS = ABS( E(I) )
105:             IF( EABS .LE. TMP1) THEN
106:                E(I) = ZERO
107:                E2(I) = ZERO
108:                ISPLIT( NSPLIT ) = I
109:                NSPLIT = NSPLIT + 1
110:             END IF
111:  9       CONTINUE
112:       ELSE
113: *        Criterion that guarantees relative accuracy
114:          DO 10 I = 1, N-1
115:             EABS = ABS( E(I) )
116:             IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) )
117:      $      THEN
118:                E(I) = ZERO
119:                E2(I) = ZERO
120:                ISPLIT( NSPLIT ) = I
121:                NSPLIT = NSPLIT + 1
122:             END IF
123:  10      CONTINUE
124:       ENDIF
125:       ISPLIT( NSPLIT ) = N
126: 
127:       RETURN
128: *
129: *     End of SLARRA
130: *
131:       END
132: