SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sdttrf.f
Go to the documentation of this file.
1 SUBROUTINE sdttrf( N, DL, D, DU, INFO )
2*
3* -- ScaLAPACK auxiliary routine (version 2.0) --
4* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver
5*
6* Written by Andrew J. Cleary, November 1996.
7* Modified from SGTTRF:
8* -- LAPACK routine (preliminary version) --
9* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
10* Courant Institute, Argonne National Lab, and Rice University
11*
12* .. Scalar Arguments ..
13 INTEGER INFO, N
14* ..
15* .. Array Arguments ..
16 REAL D( * ), DL( * ), DU( * )
17* ..
18*
19* Purpose
20* =======
21*
22* SDTTRF computes an LU factorization of a complex tridiagonal matrix A
23* using elimination without partial pivoting.
24*
25* The factorization has the form
26* A = L * U
27* where L is a product of unit lower bidiagonal
28* matrices and U is upper triangular with nonzeros in only the main
29* diagonal and first superdiagonal.
30*
31* Arguments
32* =========
33*
34* N (input) INTEGER
35* The order of the matrix A. N >= 0.
36*
37* DL (input/output) COMPLEX array, dimension (N-1)
38* On entry, DL must contain the (n-1) subdiagonal elements of
39* A.
40* On exit, DL is overwritten by the (n-1) multipliers that
41* define the matrix L from the LU factorization of A.
42*
43* D (input/output) COMPLEX array, dimension (N)
44* On entry, D must contain the diagonal elements of A.
45* On exit, D is overwritten by the n diagonal elements of the
46* upper triangular matrix U from the LU factorization of A.
47*
48* DU (input/output) COMPLEX array, dimension (N-1)
49* On entry, DU must contain the (n-1) superdiagonal elements
50* of A.
51* On exit, DU is overwritten by the (n-1) elements of the first
52* superdiagonal of U.
53*
54* INFO (output) INTEGER
55* = 0: successful exit
56* < 0: if INFO = -i, the i-th argument had an illegal value
57* > 0: if INFO = i, U(i,i) is exactly zero. The factorization
58* has been completed, but the factor U is exactly
59* singular, and division by zero will occur if it is used
60* to solve a system of equations.
61*
62* =====================================================================
63*
64* .. Local Scalars ..
65 INTEGER I
66 REAL FACT
67* ..
68* .. Intrinsic Functions ..
69 INTRINSIC abs
70* ..
71* .. External Subroutines ..
72 EXTERNAL xerbla
73* ..
74* .. Parameters ..
75 REAL ZERO
76 parameter( zero = 0.0e+0 )
77* ..
78* .. Executable Statements ..
79*
80 info = 0
81 IF( n.LT.0 ) THEN
82 info = -1
83 CALL xerbla( 'SDTTRF', -info )
84 RETURN
85 END IF
86*
87* Quick return if possible
88*
89 IF( n.EQ.0 )
90 $ RETURN
91*
92 DO 20 i = 1, n - 1
93 IF( dl( i ).EQ.zero ) THEN
94*
95* Subdiagonal is zero, no elimination is required.
96*
97 IF( d( i ).EQ.zero .AND. info.EQ.0 )
98 $ info = i
99 ELSE
100*
101 fact = dl( i ) / d( i )
102 dl( i ) = fact
103 d( i+1 ) = d( i+1 ) - fact*du( i )
104 END IF
105 20 CONTINUE
106 IF( d( n ).EQ.zero .AND. info.EQ.0 ) THEN
107 info = n
108 RETURN
109 END IF
110*
111 RETURN
112*
113* End of SDTTRF
114*
115 END
subroutine sdttrf(n, dl, d, du, info)
Definition sdttrf.f:2