1*> \brief \b CGTTRF
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGTTRF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgttrf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgttrf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgttrf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, N
25*       ..
26*       .. Array Arguments ..
27*       INTEGER            IPIV( * )
28*       COMPLEX            D( * ), DL( * ), DU( * ), DU2( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CGTTRF computes an LU factorization of a complex tridiagonal matrix A
38*> using elimination with partial pivoting and row interchanges.
39*>
40*> The factorization has the form
41*>    A = L * U
42*> where L is a product of permutation and unit lower bidiagonal
43*> matrices and U is upper triangular with nonzeros in only the main
44*> diagonal and first two superdiagonals.
45*> \endverbatim
46*
47*  Arguments:
48*  ==========
49*
50*> \param[in] N
51*> \verbatim
52*>          N is INTEGER
53*>          The order of the matrix A.
54*> \endverbatim
55*>
56*> \param[in,out] DL
57*> \verbatim
58*>          DL is COMPLEX array, dimension (N-1)
59*>          On entry, DL must contain the (n-1) sub-diagonal elements of
60*>          A.
61*>
62*>          On exit, DL is overwritten by the (n-1) multipliers that
63*>          define the matrix L from the LU factorization of A.
64*> \endverbatim
65*>
66*> \param[in,out] D
67*> \verbatim
68*>          D is COMPLEX array, dimension (N)
69*>          On entry, D must contain the diagonal elements of A.
70*>
71*>          On exit, D is overwritten by the n diagonal elements of the
72*>          upper triangular matrix U from the LU factorization of A.
73*> \endverbatim
74*>
75*> \param[in,out] DU
76*> \verbatim
77*>          DU is COMPLEX array, dimension (N-1)
78*>          On entry, DU must contain the (n-1) super-diagonal elements
79*>          of A.
80*>
81*>          On exit, DU is overwritten by the (n-1) elements of the first
82*>          super-diagonal of U.
83*> \endverbatim
84*>
85*> \param[out] DU2
86*> \verbatim
87*>          DU2 is COMPLEX array, dimension (N-2)
88*>          On exit, DU2 is overwritten by the (n-2) elements of the
89*>          second super-diagonal of U.
90*> \endverbatim
91*>
92*> \param[out] IPIV
93*> \verbatim
94*>          IPIV is INTEGER array, dimension (N)
95*>          The pivot indices; for 1 <= i <= n, row i of the matrix was
96*>          interchanged with row IPIV(i).  IPIV(i) will always be either
97*>          i or i+1; IPIV(i) = i indicates a row interchange was not
98*>          required.
99*> \endverbatim
100*>
101*> \param[out] INFO
102*> \verbatim
103*>          INFO is INTEGER
104*>          = 0:  successful exit
105*>          < 0:  if INFO = -k, the k-th argument had an illegal value
106*>          > 0:  if INFO = k, U(k,k) is exactly zero. The factorization
107*>                has been completed, but the factor U is exactly
108*>                singular, and division by zero will occur if it is used
109*>                to solve a system of equations.
110*> \endverbatim
111*
112*  Authors:
113*  ========
114*
115*> \author Univ. of Tennessee
116*> \author Univ. of California Berkeley
117*> \author Univ. of Colorado Denver
118*> \author NAG Ltd.
119*
120*> \ingroup complexGTcomputational
121*
122*  =====================================================================
123      SUBROUTINE CGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
124*
125*  -- LAPACK computational routine --
126*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
127*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128*
129*     .. Scalar Arguments ..
130      INTEGER            INFO, N
131*     ..
132*     .. Array Arguments ..
133      INTEGER            IPIV( * )
134      COMPLEX            D( * ), DL( * ), DU( * ), DU2( * )
135*     ..
136*
137*  =====================================================================
138*
139*     .. Parameters ..
140      REAL               ZERO
141      PARAMETER          ( ZERO = 0.0E+0 )
142*     ..
143*     .. Local Scalars ..
144      INTEGER            I
145      COMPLEX            FACT, TEMP, ZDUM
146*     ..
147*     .. External Subroutines ..
148      EXTERNAL           XERBLA
149*     ..
150*     .. Intrinsic Functions ..
151      INTRINSIC          ABS, AIMAG, REAL
152*     ..
153*     .. Statement Functions ..
154      REAL               CABS1
155*     ..
156*     .. Statement Function definitions ..
157      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
158*     ..
159*     .. Executable Statements ..
160*
161      INFO = 0
162      IF( N.LT.0 ) THEN
163         INFO = -1
164         CALL XERBLA( 'CGTTRF', -INFO )
165         RETURN
166      END IF
167*
168*     Quick return if possible
169*
170      IF( N.EQ.0 )
171     $   RETURN
172*
173*     Initialize IPIV(i) = i and DU2(i) = 0
174*
175      DO 10 I = 1, N
176         IPIV( I ) = I
177   10 CONTINUE
178      DO 20 I = 1, N - 2
179         DU2( I ) = ZERO
180   20 CONTINUE
181*
182      DO 30 I = 1, N - 2
183         IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
184*
185*           No row interchange required, eliminate DL(I)
186*
187            IF( CABS1( D( I ) ).NE.ZERO ) THEN
188               FACT = DL( I ) / D( I )
189               DL( I ) = FACT
190               D( I+1 ) = D( I+1 ) - FACT*DU( I )
191            END IF
192         ELSE
193*
194*           Interchange rows I and I+1, eliminate DL(I)
195*
196            FACT = D( I ) / DL( I )
197            D( I ) = DL( I )
198            DL( I ) = FACT
199            TEMP = DU( I )
200            DU( I ) = D( I+1 )
201            D( I+1 ) = TEMP - FACT*D( I+1 )
202            DU2( I ) = DU( I+1 )
203            DU( I+1 ) = -FACT*DU( I+1 )
204            IPIV( I ) = I + 1
205         END IF
206   30 CONTINUE
207      IF( N.GT.1 ) THEN
208         I = N - 1
209         IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
210            IF( CABS1( D( I ) ).NE.ZERO ) THEN
211               FACT = DL( I ) / D( I )
212               DL( I ) = FACT
213               D( I+1 ) = D( I+1 ) - FACT*DU( I )
214            END IF
215         ELSE
216            FACT = D( I ) / DL( I )
217            D( I ) = DL( I )
218            DL( I ) = FACT
219            TEMP = DU( I )
220            DU( I ) = D( I+1 )
221            D( I+1 ) = TEMP - FACT*D( I+1 )
222            IPIV( I ) = I + 1
223         END IF
224      END IF
225*
226*     Check for a zero on the diagonal of U.
227*
228      DO 40 I = 1, N
229         IF( CABS1( D( I ) ).EQ.ZERO ) THEN
230            INFO = I
231            GO TO 50
232         END IF
233   40 CONTINUE
234   50 CONTINUE
235*
236      RETURN
237*
238*     End of CGTTRF
239*
240      END
241