001:       SUBROUTINE DLAGTF( N, A, LAMBDA, B, C, TOL, D, IN, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       INTEGER            INFO, N
009:       DOUBLE PRECISION   LAMBDA, TOL
010: *     ..
011: *     .. Array Arguments ..
012:       INTEGER            IN( * )
013:       DOUBLE PRECISION   A( * ), B( * ), C( * ), D( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DLAGTF factorizes the matrix (T - lambda*I), where T is an n by n
020: *  tridiagonal matrix and lambda is a scalar, as
021: *
022: *     T - lambda*I = PLU,
023: *
024: *  where P is a permutation matrix, L is a unit lower tridiagonal matrix
025: *  with at most one non-zero sub-diagonal elements per column and U is
026: *  an upper triangular matrix with at most two non-zero super-diagonal
027: *  elements per column.
028: *
029: *  The factorization is obtained by Gaussian elimination with partial
030: *  pivoting and implicit row scaling.
031: *
032: *  The parameter LAMBDA is included in the routine so that DLAGTF may
033: *  be used, in conjunction with DLAGTS, to obtain eigenvectors of T by
034: *  inverse iteration.
035: *
036: *  Arguments
037: *  =========
038: *
039: *  N       (input) INTEGER
040: *          The order of the matrix T.
041: *
042: *  A       (input/output) DOUBLE PRECISION array, dimension (N)
043: *          On entry, A must contain the diagonal elements of T.
044: *
045: *          On exit, A is overwritten by the n diagonal elements of the
046: *          upper triangular matrix U of the factorization of T.
047: *
048: *  LAMBDA  (input) DOUBLE PRECISION
049: *          On entry, the scalar lambda.
050: *
051: *  B       (input/output) DOUBLE PRECISION array, dimension (N-1)
052: *          On entry, B must contain the (n-1) super-diagonal elements of
053: *          T.
054: *
055: *          On exit, B is overwritten by the (n-1) super-diagonal
056: *          elements of the matrix U of the factorization of T.
057: *
058: *  C       (input/output) DOUBLE PRECISION array, dimension (N-1)
059: *          On entry, C must contain the (n-1) sub-diagonal elements of
060: *          T.
061: *
062: *          On exit, C is overwritten by the (n-1) sub-diagonal elements
063: *          of the matrix L of the factorization of T.
064: *
065: *  TOL     (input) DOUBLE PRECISION
066: *          On entry, a relative tolerance used to indicate whether or
067: *          not the matrix (T - lambda*I) is nearly singular. TOL should
068: *          normally be chose as approximately the largest relative error
069: *          in the elements of T. For example, if the elements of T are
070: *          correct to about 4 significant figures, then TOL should be
071: *          set to about 5*10**(-4). If TOL is supplied as less than eps,
072: *          where eps is the relative machine precision, then the value
073: *          eps is used in place of TOL.
074: *
075: *  D       (output) DOUBLE PRECISION array, dimension (N-2)
076: *          On exit, D is overwritten by the (n-2) second super-diagonal
077: *          elements of the matrix U of the factorization of T.
078: *
079: *  IN      (output) INTEGER array, dimension (N)
080: *          On exit, IN contains details of the permutation matrix P. If
081: *          an interchange occurred at the kth step of the elimination,
082: *          then IN(k) = 1, otherwise IN(k) = 0. The element IN(n)
083: *          returns the smallest positive integer j such that
084: *
085: *             abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL,
086: *
087: *          where norm( A(j) ) denotes the sum of the absolute values of
088: *          the jth row of the matrix A. If no such j exists then IN(n)
089: *          is returned as zero. If IN(n) is returned as positive, then a
090: *          diagonal element of U is small, indicating that
091: *          (T - lambda*I) is singular or nearly singular,
092: *
093: *  INFO    (output) INTEGER
094: *          = 0   : successful exit
095: *          .lt. 0: if INFO = -k, the kth argument had an illegal value
096: *
097: * =====================================================================
098: *
099: *     .. Parameters ..
100:       DOUBLE PRECISION   ZERO
101:       PARAMETER          ( ZERO = 0.0D+0 )
102: *     ..
103: *     .. Local Scalars ..
104:       INTEGER            K
105:       DOUBLE PRECISION   EPS, MULT, PIV1, PIV2, SCALE1, SCALE2, TEMP, TL
106: *     ..
107: *     .. Intrinsic Functions ..
108:       INTRINSIC          ABS, MAX
109: *     ..
110: *     .. External Functions ..
111:       DOUBLE PRECISION   DLAMCH
112:       EXTERNAL           DLAMCH
113: *     ..
114: *     .. External Subroutines ..
115:       EXTERNAL           XERBLA
116: *     ..
117: *     .. Executable Statements ..
118: *
119:       INFO = 0
120:       IF( N.LT.0 ) THEN
121:          INFO = -1
122:          CALL XERBLA( 'DLAGTF', -INFO )
123:          RETURN
124:       END IF
125: *
126:       IF( N.EQ.0 )
127:      $   RETURN
128: *
129:       A( 1 ) = A( 1 ) - LAMBDA
130:       IN( N ) = 0
131:       IF( N.EQ.1 ) THEN
132:          IF( A( 1 ).EQ.ZERO )
133:      $      IN( 1 ) = 1
134:          RETURN
135:       END IF
136: *
137:       EPS = DLAMCH( 'Epsilon' )
138: *
139:       TL = MAX( TOL, EPS )
140:       SCALE1 = ABS( A( 1 ) ) + ABS( B( 1 ) )
141:       DO 10 K = 1, N - 1
142:          A( K+1 ) = A( K+1 ) - LAMBDA
143:          SCALE2 = ABS( C( K ) ) + ABS( A( K+1 ) )
144:          IF( K.LT.( N-1 ) )
145:      $      SCALE2 = SCALE2 + ABS( B( K+1 ) )
146:          IF( A( K ).EQ.ZERO ) THEN
147:             PIV1 = ZERO
148:          ELSE
149:             PIV1 = ABS( A( K ) ) / SCALE1
150:          END IF
151:          IF( C( K ).EQ.ZERO ) THEN
152:             IN( K ) = 0
153:             PIV2 = ZERO
154:             SCALE1 = SCALE2
155:             IF( K.LT.( N-1 ) )
156:      $         D( K ) = ZERO
157:          ELSE
158:             PIV2 = ABS( C( K ) ) / SCALE2
159:             IF( PIV2.LE.PIV1 ) THEN
160:                IN( K ) = 0
161:                SCALE1 = SCALE2
162:                C( K ) = C( K ) / A( K )
163:                A( K+1 ) = A( K+1 ) - C( K )*B( K )
164:                IF( K.LT.( N-1 ) )
165:      $            D( K ) = ZERO
166:             ELSE
167:                IN( K ) = 1
168:                MULT = A( K ) / C( K )
169:                A( K ) = C( K )
170:                TEMP = A( K+1 )
171:                A( K+1 ) = B( K ) - MULT*TEMP
172:                IF( K.LT.( N-1 ) ) THEN
173:                   D( K ) = B( K+1 )
174:                   B( K+1 ) = -MULT*D( K )
175:                END IF
176:                B( K ) = TEMP
177:                C( K ) = MULT
178:             END IF
179:          END IF
180:          IF( ( MAX( PIV1, PIV2 ).LE.TL ) .AND. ( IN( N ).EQ.0 ) )
181:      $      IN( N ) = K
182:    10 CONTINUE
183:       IF( ( ABS( A( N ) ).LE.SCALE1*TL ) .AND. ( IN( N ).EQ.0 ) )
184:      $   IN( N ) = N
185: *
186:       RETURN
187: *
188: *     End of DLAGTF
189: *
190:       END
191: