001:       SUBROUTINE SGTTRF( N, DL, D, DU, DU2, IPIV, 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: *     ..
010: *     .. Array Arguments ..
011:       INTEGER            IPIV( * )
012:       REAL               D( * ), DL( * ), DU( * ), DU2( * )
013: *     ..
014: *
015: *  Purpose
016: *  =======
017: *
018: *  SGTTRF computes an LU factorization of a real tridiagonal matrix A
019: *  using elimination with partial pivoting and row interchanges.
020: *
021: *  The factorization has the form
022: *     A = L * U
023: *  where L is a product of permutation and unit lower bidiagonal
024: *  matrices and U is upper triangular with nonzeros in only the main
025: *  diagonal and first two superdiagonals.
026: *
027: *  Arguments
028: *  =========
029: *
030: *  N       (input) INTEGER
031: *          The order of the matrix A.
032: *
033: *  DL      (input/output) REAL array, dimension (N-1)
034: *          On entry, DL must contain the (n-1) sub-diagonal elements of
035: *          A.
036: *
037: *          On exit, DL is overwritten by the (n-1) multipliers that
038: *          define the matrix L from the LU factorization of A.
039: *
040: *  D       (input/output) REAL array, dimension (N)
041: *          On entry, D must contain the diagonal elements of A.
042: *
043: *          On exit, D is overwritten by the n diagonal elements of the
044: *          upper triangular matrix U from the LU factorization of A.
045: *
046: *  DU      (input/output) REAL array, dimension (N-1)
047: *          On entry, DU must contain the (n-1) super-diagonal elements
048: *          of A.
049: *
050: *          On exit, DU is overwritten by the (n-1) elements of the first
051: *          super-diagonal of U.
052: *
053: *  DU2     (output) REAL array, dimension (N-2)
054: *          On exit, DU2 is overwritten by the (n-2) elements of the
055: *          second super-diagonal of U.
056: *
057: *  IPIV    (output) INTEGER array, dimension (N)
058: *          The pivot indices; for 1 <= i <= n, row i of the matrix was
059: *          interchanged with row IPIV(i).  IPIV(i) will always be either
060: *          i or i+1; IPIV(i) = i indicates a row interchange was not
061: *          required.
062: *
063: *  INFO    (output) INTEGER
064: *          = 0:  successful exit
065: *          < 0:  if INFO = -k, the k-th argument had an illegal value
066: *          > 0:  if INFO = k, U(k,k) is exactly zero. The factorization
067: *                has been completed, but the factor U is exactly
068: *                singular, and division by zero will occur if it is used
069: *                to solve a system of equations.
070: *
071: *  =====================================================================
072: *
073: *     .. Parameters ..
074:       REAL               ZERO
075:       PARAMETER          ( ZERO = 0.0E+0 )
076: *     ..
077: *     .. Local Scalars ..
078:       INTEGER            I
079:       REAL               FACT, TEMP
080: *     ..
081: *     .. Intrinsic Functions ..
082:       INTRINSIC          ABS
083: *     ..
084: *     .. External Subroutines ..
085:       EXTERNAL           XERBLA
086: *     ..
087: *     .. Executable Statements ..
088: *
089:       INFO = 0
090:       IF( N.LT.0 ) THEN
091:          INFO = -1
092:          CALL XERBLA( 'SGTTRF', -INFO )
093:          RETURN
094:       END IF
095: *
096: *     Quick return if possible
097: *
098:       IF( N.EQ.0 )
099:      $   RETURN
100: *
101: *     Initialize IPIV(i) = i and DU2(I) = 0
102: *
103:       DO 10 I = 1, N
104:          IPIV( I ) = I
105:    10 CONTINUE
106:       DO 20 I = 1, N - 2
107:          DU2( I ) = ZERO
108:    20 CONTINUE
109: *
110:       DO 30 I = 1, N - 2
111:          IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
112: *
113: *           No row interchange required, eliminate DL(I)
114: *
115:             IF( D( I ).NE.ZERO ) THEN
116:                FACT = DL( I ) / D( I )
117:                DL( I ) = FACT
118:                D( I+1 ) = D( I+1 ) - FACT*DU( I )
119:             END IF
120:          ELSE
121: *
122: *           Interchange rows I and I+1, eliminate DL(I)
123: *
124:             FACT = D( I ) / DL( I )
125:             D( I ) = DL( I )
126:             DL( I ) = FACT
127:             TEMP = DU( I )
128:             DU( I ) = D( I+1 )
129:             D( I+1 ) = TEMP - FACT*D( I+1 )
130:             DU2( I ) = DU( I+1 )
131:             DU( I+1 ) = -FACT*DU( I+1 )
132:             IPIV( I ) = I + 1
133:          END IF
134:    30 CONTINUE
135:       IF( N.GT.1 ) THEN
136:          I = N - 1
137:          IF( ABS( D( I ) ).GE.ABS( DL( I ) ) ) THEN
138:             IF( D( I ).NE.ZERO ) THEN
139:                FACT = DL( I ) / D( I )
140:                DL( I ) = FACT
141:                D( I+1 ) = D( I+1 ) - FACT*DU( I )
142:             END IF
143:          ELSE
144:             FACT = D( I ) / DL( I )
145:             D( I ) = DL( I )
146:             DL( I ) = FACT
147:             TEMP = DU( I )
148:             DU( I ) = D( I+1 )
149:             D( I+1 ) = TEMP - FACT*D( I+1 )
150:             IPIV( I ) = I + 1
151:          END IF
152:       END IF
153: *
154: *     Check for a zero on the diagonal of U.
155: *
156:       DO 40 I = 1, N
157:          IF( D( I ).EQ.ZERO ) THEN
158:             INFO = I
159:             GO TO 50
160:          END IF
161:    40 CONTINUE
162:    50 CONTINUE
163: *
164:       RETURN
165: *
166: *     End of SGTTRF
167: *
168:       END
169: