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