1 SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
2 $ INFO )
3 *
4 * -- LAPACK routine (version 3.2) --
5 * -- LAPACK is a software package provided by Univ. of Tennessee, --
6 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER TRANS
11 INTEGER INFO, LDB, N, NRHS
12 * ..
13 * .. Array Arguments ..
14 INTEGER IPIV( * )
15 COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZGTTRS solves one of the systems of equations
22 * A * X = B, A**T * X = B, or A**H * X = B,
23 * with a tridiagonal matrix A using the LU factorization computed
24 * by ZGTTRF.
25 *
26 * Arguments
27 * =========
28 *
29 * TRANS (input) CHARACTER*1
30 * Specifies the form of the system of equations.
31 * = 'N': A * X = B (No transpose)
32 * = 'T': A**T * X = B (Transpose)
33 * = 'C': A**H * X = B (Conjugate transpose)
34 *
35 * N (input) INTEGER
36 * The order of the matrix A.
37 *
38 * NRHS (input) INTEGER
39 * The number of right hand sides, i.e., the number of columns
40 * of the matrix B. NRHS >= 0.
41 *
42 * DL (input) COMPLEX*16 array, dimension (N-1)
43 * The (n-1) multipliers that define the matrix L from the
44 * LU factorization of A.
45 *
46 * D (input) COMPLEX*16 array, dimension (N)
47 * The n diagonal elements of the upper triangular matrix U from
48 * the LU factorization of A.
49 *
50 * DU (input) COMPLEX*16 array, dimension (N-1)
51 * The (n-1) elements of the first super-diagonal of U.
52 *
53 * DU2 (input) COMPLEX*16 array, dimension (N-2)
54 * The (n-2) elements of the second super-diagonal of U.
55 *
56 * IPIV (input) INTEGER array, dimension (N)
57 * The pivot indices; for 1 <= i <= n, row i of the matrix was
58 * interchanged with row IPIV(i). IPIV(i) will always be either
59 * i or i+1; IPIV(i) = i indicates a row interchange was not
60 * required.
61 *
62 * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
63 * On entry, the matrix of right hand side vectors B.
64 * On exit, B is overwritten by the solution vectors X.
65 *
66 * LDB (input) INTEGER
67 * The leading dimension of the array B. LDB >= max(1,N).
68 *
69 * INFO (output) INTEGER
70 * = 0: successful exit
71 * < 0: if INFO = -k, the k-th argument had an illegal value
72 *
73 * =====================================================================
74 *
75 * .. Local Scalars ..
76 LOGICAL NOTRAN
77 INTEGER ITRANS, J, JB, NB
78 * ..
79 * .. External Functions ..
80 INTEGER ILAENV
81 EXTERNAL ILAENV
82 * ..
83 * .. External Subroutines ..
84 EXTERNAL XERBLA, ZGTTS2
85 * ..
86 * .. Intrinsic Functions ..
87 INTRINSIC MAX, MIN
88 * ..
89 * .. Executable Statements ..
90 *
91 INFO = 0
92 NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
93 IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
94 $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
95 INFO = -1
96 ELSE IF( N.LT.0 ) THEN
97 INFO = -2
98 ELSE IF( NRHS.LT.0 ) THEN
99 INFO = -3
100 ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
101 INFO = -10
102 END IF
103 IF( INFO.NE.0 ) THEN
104 CALL XERBLA( 'ZGTTRS', -INFO )
105 RETURN
106 END IF
107 *
108 * Quick return if possible
109 *
110 IF( N.EQ.0 .OR. NRHS.EQ.0 )
111 $ RETURN
112 *
113 * Decode TRANS
114 *
115 IF( NOTRAN ) THEN
116 ITRANS = 0
117 ELSE IF( TRANS.EQ.'T' .OR. TRANS.EQ.'t' ) THEN
118 ITRANS = 1
119 ELSE
120 ITRANS = 2
121 END IF
122 *
123 * Determine the number of right-hand sides to solve at a time.
124 *
125 IF( NRHS.EQ.1 ) THEN
126 NB = 1
127 ELSE
128 NB = MAX( 1, ILAENV( 1, 'ZGTTRS', TRANS, N, NRHS, -1, -1 ) )
129 END IF
130 *
131 IF( NB.GE.NRHS ) THEN
132 CALL ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
133 ELSE
134 DO 10 J = 1, NRHS, NB
135 JB = MIN( NRHS-J+1, NB )
136 CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
137 $ LDB )
138 10 CONTINUE
139 END IF
140 *
141 * End of ZGTTRS
142 *
143 END
2 $ INFO )
3 *
4 * -- LAPACK routine (version 3.2) --
5 * -- LAPACK is a software package provided by Univ. of Tennessee, --
6 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER TRANS
11 INTEGER INFO, LDB, N, NRHS
12 * ..
13 * .. Array Arguments ..
14 INTEGER IPIV( * )
15 COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZGTTRS solves one of the systems of equations
22 * A * X = B, A**T * X = B, or A**H * X = B,
23 * with a tridiagonal matrix A using the LU factorization computed
24 * by ZGTTRF.
25 *
26 * Arguments
27 * =========
28 *
29 * TRANS (input) CHARACTER*1
30 * Specifies the form of the system of equations.
31 * = 'N': A * X = B (No transpose)
32 * = 'T': A**T * X = B (Transpose)
33 * = 'C': A**H * X = B (Conjugate transpose)
34 *
35 * N (input) INTEGER
36 * The order of the matrix A.
37 *
38 * NRHS (input) INTEGER
39 * The number of right hand sides, i.e., the number of columns
40 * of the matrix B. NRHS >= 0.
41 *
42 * DL (input) COMPLEX*16 array, dimension (N-1)
43 * The (n-1) multipliers that define the matrix L from the
44 * LU factorization of A.
45 *
46 * D (input) COMPLEX*16 array, dimension (N)
47 * The n diagonal elements of the upper triangular matrix U from
48 * the LU factorization of A.
49 *
50 * DU (input) COMPLEX*16 array, dimension (N-1)
51 * The (n-1) elements of the first super-diagonal of U.
52 *
53 * DU2 (input) COMPLEX*16 array, dimension (N-2)
54 * The (n-2) elements of the second super-diagonal of U.
55 *
56 * IPIV (input) INTEGER array, dimension (N)
57 * The pivot indices; for 1 <= i <= n, row i of the matrix was
58 * interchanged with row IPIV(i). IPIV(i) will always be either
59 * i or i+1; IPIV(i) = i indicates a row interchange was not
60 * required.
61 *
62 * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
63 * On entry, the matrix of right hand side vectors B.
64 * On exit, B is overwritten by the solution vectors X.
65 *
66 * LDB (input) INTEGER
67 * The leading dimension of the array B. LDB >= max(1,N).
68 *
69 * INFO (output) INTEGER
70 * = 0: successful exit
71 * < 0: if INFO = -k, the k-th argument had an illegal value
72 *
73 * =====================================================================
74 *
75 * .. Local Scalars ..
76 LOGICAL NOTRAN
77 INTEGER ITRANS, J, JB, NB
78 * ..
79 * .. External Functions ..
80 INTEGER ILAENV
81 EXTERNAL ILAENV
82 * ..
83 * .. External Subroutines ..
84 EXTERNAL XERBLA, ZGTTS2
85 * ..
86 * .. Intrinsic Functions ..
87 INTRINSIC MAX, MIN
88 * ..
89 * .. Executable Statements ..
90 *
91 INFO = 0
92 NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
93 IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
94 $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
95 INFO = -1
96 ELSE IF( N.LT.0 ) THEN
97 INFO = -2
98 ELSE IF( NRHS.LT.0 ) THEN
99 INFO = -3
100 ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
101 INFO = -10
102 END IF
103 IF( INFO.NE.0 ) THEN
104 CALL XERBLA( 'ZGTTRS', -INFO )
105 RETURN
106 END IF
107 *
108 * Quick return if possible
109 *
110 IF( N.EQ.0 .OR. NRHS.EQ.0 )
111 $ RETURN
112 *
113 * Decode TRANS
114 *
115 IF( NOTRAN ) THEN
116 ITRANS = 0
117 ELSE IF( TRANS.EQ.'T' .OR. TRANS.EQ.'t' ) THEN
118 ITRANS = 1
119 ELSE
120 ITRANS = 2
121 END IF
122 *
123 * Determine the number of right-hand sides to solve at a time.
124 *
125 IF( NRHS.EQ.1 ) THEN
126 NB = 1
127 ELSE
128 NB = MAX( 1, ILAENV( 1, 'ZGTTRS', TRANS, N, NRHS, -1, -1 ) )
129 END IF
130 *
131 IF( NB.GE.NRHS ) THEN
132 CALL ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
133 ELSE
134 DO 10 J = 1, NRHS, NB
135 JB = MIN( NRHS-J+1, NB )
136 CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
137 $ LDB )
138 10 CONTINUE
139 END IF
140 *
141 * End of ZGTTRS
142 *
143 END