LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zpttrs.f
Go to the documentation of this file.
1*> \brief \b ZPTTRS
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download ZPTTRS + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zpttrs.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zpttrs.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zpttrs.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE ZPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO )
20*
21* .. Scalar Arguments ..
22* CHARACTER UPLO
23* INTEGER INFO, LDB, N, NRHS
24* ..
25* .. Array Arguments ..
26* DOUBLE PRECISION D( * )
27* COMPLEX*16 B( LDB, * ), E( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> ZPTTRS solves a tridiagonal system of the form
37*> A * X = B
38*> using the factorization A = U**H *D* U or A = L*D*L**H computed by ZPTTRF.
39*> D is a diagonal matrix specified in the vector D, U (or L) is a unit
40*> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in
41*> the vector E, and X and B are N by NRHS matrices.
42*> \endverbatim
43*
44* Arguments:
45* ==========
46*
47*> \param[in] UPLO
48*> \verbatim
49*> UPLO is CHARACTER*1
50*> Specifies the form of the factorization and whether the
51*> vector E is the superdiagonal of the upper bidiagonal factor
52*> U or the subdiagonal of the lower bidiagonal factor L.
53*> = 'U': A = U**H *D*U, E is the superdiagonal of U
54*> = 'L': A = L*D*L**H, E is the subdiagonal of L
55*> \endverbatim
56*>
57*> \param[in] N
58*> \verbatim
59*> N is INTEGER
60*> The order of the tridiagonal matrix A. N >= 0.
61*> \endverbatim
62*>
63*> \param[in] NRHS
64*> \verbatim
65*> NRHS is INTEGER
66*> The number of right hand sides, i.e., the number of columns
67*> of the matrix B. NRHS >= 0.
68*> \endverbatim
69*>
70*> \param[in] D
71*> \verbatim
72*> D is DOUBLE PRECISION array, dimension (N)
73*> The n diagonal elements of the diagonal matrix D from the
74*> factorization A = U**H *D*U or A = L*D*L**H.
75*> \endverbatim
76*>
77*> \param[in] E
78*> \verbatim
79*> E is COMPLEX*16 array, dimension (N-1)
80*> If UPLO = 'U', the (n-1) superdiagonal elements of the unit
81*> bidiagonal factor U from the factorization A = U**H*D*U.
82*> If UPLO = 'L', the (n-1) subdiagonal elements of the unit
83*> bidiagonal factor L from the factorization A = L*D*L**H.
84*> \endverbatim
85*>
86*> \param[in,out] B
87*> \verbatim
88*> B is COMPLEX*16 array, dimension (LDB,NRHS)
89*> On entry, the right hand side vectors B for the system of
90*> linear equations.
91*> On exit, the solution vectors, X.
92*> \endverbatim
93*>
94*> \param[in] LDB
95*> \verbatim
96*> LDB is INTEGER
97*> The leading dimension of the array B. LDB >= max(1,N).
98*> \endverbatim
99*>
100*> \param[out] INFO
101*> \verbatim
102*> INFO is INTEGER
103*> = 0: successful exit
104*> < 0: if INFO = -k, the k-th argument had an illegal value
105*> \endverbatim
106*
107* Authors:
108* ========
109*
110*> \author Univ. of Tennessee
111*> \author Univ. of California Berkeley
112*> \author Univ. of Colorado Denver
113*> \author NAG Ltd.
114*
115*> \ingroup pttrs
116*
117* =====================================================================
118 SUBROUTINE zpttrs( UPLO, N, NRHS, D, E, B, LDB, INFO )
119*
120* -- LAPACK computational routine --
121* -- LAPACK is a software package provided by Univ. of Tennessee, --
122* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
123*
124* .. Scalar Arguments ..
125 CHARACTER UPLO
126 INTEGER INFO, LDB, N, NRHS
127* ..
128* .. Array Arguments ..
129 DOUBLE PRECISION D( * )
130 COMPLEX*16 B( LDB, * ), E( * )
131* ..
132*
133* =====================================================================
134*
135* .. Local Scalars ..
136 LOGICAL UPPER
137 INTEGER IUPLO, J, JB, NB
138* ..
139* .. External Functions ..
140 INTEGER ILAENV
141 EXTERNAL ilaenv
142* ..
143* .. External Subroutines ..
144 EXTERNAL xerbla, zptts2
145* ..
146* .. Intrinsic Functions ..
147 INTRINSIC max, min
148* ..
149* .. Executable Statements ..
150*
151* Test the input arguments.
152*
153 info = 0
154 upper = ( uplo.EQ.'U' .OR. uplo.EQ.'u' )
155 IF( .NOT.upper .AND. .NOT.( uplo.EQ.'L' .OR. uplo.EQ.'l' ) ) THEN
156 info = -1
157 ELSE IF( n.LT.0 ) THEN
158 info = -2
159 ELSE IF( nrhs.LT.0 ) THEN
160 info = -3
161 ELSE IF( ldb.LT.max( 1, n ) ) THEN
162 info = -7
163 END IF
164 IF( info.NE.0 ) THEN
165 CALL xerbla( 'ZPTTRS', -info )
166 RETURN
167 END IF
168*
169* Quick return if possible
170*
171 IF( n.EQ.0 .OR. nrhs.EQ.0 )
172 $ RETURN
173*
174* Determine the number of right-hand sides to solve at a time.
175*
176 IF( nrhs.EQ.1 ) THEN
177 nb = 1
178 ELSE
179 nb = max( 1, ilaenv( 1, 'ZPTTRS', uplo, n, nrhs, -1, -1 ) )
180 END IF
181*
182* Decode UPLO
183*
184 IF( upper ) THEN
185 iuplo = 1
186 ELSE
187 iuplo = 0
188 END IF
189*
190 IF( nb.GE.nrhs ) THEN
191 CALL zptts2( iuplo, n, nrhs, d, e, b, ldb )
192 ELSE
193 DO 10 j = 1, nrhs, nb
194 jb = min( nrhs-j+1, nb )
195 CALL zptts2( iuplo, n, jb, d, e, b( 1, j ), ldb )
196 10 CONTINUE
197 END IF
198*
199 RETURN
200*
201* End of ZPTTRS
202*
203 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zpttrs(uplo, n, nrhs, d, e, b, ldb, info)
ZPTTRS
Definition zpttrs.f:119
subroutine zptts2(iuplo, n, nrhs, d, e, b, ldb)
ZPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf...
Definition zptts2.f:111