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
209