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