001:       SUBROUTINE CGTTRF( 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:       COMPLEX            D( * ), DL( * ), DU( * ), DU2( * )
013: *     ..
014: *
015: *  Purpose
016: *  =======
017: *
018: *  CGTTRF computes an LU factorization of a complex 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) COMPLEX 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) COMPLEX 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) COMPLEX 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) COMPLEX 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:       COMPLEX            FACT, TEMP, ZDUM
080: *     ..
081: *     .. External Subroutines ..
082:       EXTERNAL           XERBLA
083: *     ..
084: *     .. Intrinsic Functions ..
085:       INTRINSIC          ABS, AIMAG, REAL
086: *     ..
087: *     .. Statement Functions ..
088:       REAL               CABS1
089: *     ..
090: *     .. Statement Function definitions ..
091:       CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
092: *     ..
093: *     .. Executable Statements ..
094: *
095:       INFO = 0
096:       IF( N.LT.0 ) THEN
097:          INFO = -1
098:          CALL XERBLA( 'CGTTRF', -INFO )
099:          RETURN
100:       END IF
101: *
102: *     Quick return if possible
103: *
104:       IF( N.EQ.0 )
105:      $   RETURN
106: *
107: *     Initialize IPIV(i) = i and DU2(i) = 0
108: *
109:       DO 10 I = 1, N
110:          IPIV( I ) = I
111:    10 CONTINUE
112:       DO 20 I = 1, N - 2
113:          DU2( I ) = ZERO
114:    20 CONTINUE
115: *
116:       DO 30 I = 1, N - 2
117:          IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
118: *
119: *           No row interchange required, eliminate DL(I)
120: *
121:             IF( CABS1( D( I ) ).NE.ZERO ) THEN
122:                FACT = DL( I ) / D( I )
123:                DL( I ) = FACT
124:                D( I+1 ) = D( I+1 ) - FACT*DU( I )
125:             END IF
126:          ELSE
127: *
128: *           Interchange rows I and I+1, eliminate DL(I)
129: *
130:             FACT = D( I ) / DL( I )
131:             D( I ) = DL( I )
132:             DL( I ) = FACT
133:             TEMP = DU( I )
134:             DU( I ) = D( I+1 )
135:             D( I+1 ) = TEMP - FACT*D( I+1 )
136:             DU2( I ) = DU( I+1 )
137:             DU( I+1 ) = -FACT*DU( I+1 )
138:             IPIV( I ) = I + 1
139:          END IF
140:    30 CONTINUE
141:       IF( N.GT.1 ) THEN
142:          I = N - 1
143:          IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
144:             IF( CABS1( D( I ) ).NE.ZERO ) THEN
145:                FACT = DL( I ) / D( I )
146:                DL( I ) = FACT
147:                D( I+1 ) = D( I+1 ) - FACT*DU( I )
148:             END IF
149:          ELSE
150:             FACT = D( I ) / DL( I )
151:             D( I ) = DL( I )
152:             DL( I ) = FACT
153:             TEMP = DU( I )
154:             DU( I ) = D( I+1 )
155:             D( I+1 ) = TEMP - FACT*D( I+1 )
156:             IPIV( I ) = I + 1
157:          END IF
158:       END IF
159: *
160: *     Check for a zero on the diagonal of U.
161: *
162:       DO 40 I = 1, N
163:          IF( CABS1( D( I ) ).EQ.ZERO ) THEN
164:             INFO = I
165:             GO TO 50
166:          END IF
167:    40 CONTINUE
168:    50 CONTINUE
169: *
170:       RETURN
171: *
172: *     End of CGTTRF
173: *
174:       END
175: