1*> \brief <b> CPTSV computes the solution to system of linear equations A * X = B for PT matrices</b>
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CPTSV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cptsv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cptsv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cptsv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CPTSV( N, NRHS, D, E, B, LDB, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, LDB, N, NRHS
25*       ..
26*       .. Array Arguments ..
27*       REAL               D( * )
28*       COMPLEX            B( LDB, * ), E( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CPTSV computes the solution to a complex system of linear equations
38*> A*X = B, where A is an N-by-N Hermitian positive definite tridiagonal
39*> matrix, and X and B are N-by-NRHS matrices.
40*>
41*> A is factored as A = L*D*L**H, and the factored form of A is then
42*> used to solve the system of equations.
43*> \endverbatim
44*
45*  Arguments:
46*  ==========
47*
48*> \param[in] N
49*> \verbatim
50*>          N is INTEGER
51*>          The order of the matrix A.  N >= 0.
52*> \endverbatim
53*>
54*> \param[in] NRHS
55*> \verbatim
56*>          NRHS is INTEGER
57*>          The number of right hand sides, i.e., the number of columns
58*>          of the matrix B.  NRHS >= 0.
59*> \endverbatim
60*>
61*> \param[in,out] D
62*> \verbatim
63*>          D is REAL array, dimension (N)
64*>          On entry, the n diagonal elements of the tridiagonal matrix
65*>          A.  On exit, the n diagonal elements of the diagonal matrix
66*>          D from the factorization A = L*D*L**H.
67*> \endverbatim
68*>
69*> \param[in,out] E
70*> \verbatim
71*>          E is COMPLEX array, dimension (N-1)
72*>          On entry, the (n-1) subdiagonal elements of the tridiagonal
73*>          matrix A.  On exit, the (n-1) subdiagonal elements of the
74*>          unit bidiagonal factor L from the L*D*L**H factorization of
75*>          A.  E can also be regarded as the superdiagonal of the unit
76*>          bidiagonal factor U from the U**H*D*U factorization of A.
77*> \endverbatim
78*>
79*> \param[in,out] B
80*> \verbatim
81*>          B is COMPLEX array, dimension (LDB,NRHS)
82*>          On entry, the N-by-NRHS right hand side matrix B.
83*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
84*> \endverbatim
85*>
86*> \param[in] LDB
87*> \verbatim
88*>          LDB is INTEGER
89*>          The leading dimension of the array B.  LDB >= max(1,N).
90*> \endverbatim
91*>
92*> \param[out] INFO
93*> \verbatim
94*>          INFO is INTEGER
95*>          = 0:  successful exit
96*>          < 0:  if INFO = -i, the i-th argument had an illegal value
97*>          > 0:  if INFO = i, the leading minor of order i is not
98*>                positive definite, and the solution has not been
99*>                computed.  The factorization has not been completed
100*>                unless i = N.
101*> \endverbatim
102*
103*  Authors:
104*  ========
105*
106*> \author Univ. of Tennessee
107*> \author Univ. of California Berkeley
108*> \author Univ. of Colorado Denver
109*> \author NAG Ltd.
110*
111*> \date September 2012
112*
113*> \ingroup complexPTsolve
114*
115*  =====================================================================
116      SUBROUTINE CPTSV( N, NRHS, D, E, B, LDB, INFO )
117*
118*  -- LAPACK driver routine (version 3.4.2) --
119*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
120*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
121*     September 2012
122*
123*     .. Scalar Arguments ..
124      INTEGER            INFO, LDB, N, NRHS
125*     ..
126*     .. Array Arguments ..
127      REAL               D( * )
128      COMPLEX            B( LDB, * ), E( * )
129*     ..
130*
131*  =====================================================================
132*
133*     .. External Subroutines ..
134      EXTERNAL           CPTTRF, CPTTRS, XERBLA
135*     ..
136*     .. Intrinsic Functions ..
137      INTRINSIC          MAX
138*     ..
139*     .. Executable Statements ..
140*
141*     Test the input parameters.
142*
143      INFO = 0
144      IF( N.LT.0 ) THEN
145         INFO = -1
146      ELSE IF( NRHS.LT.0 ) THEN
147         INFO = -2
148      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
149         INFO = -6
150      END IF
151      IF( INFO.NE.0 ) THEN
152         CALL XERBLA( 'CPTSV ', -INFO )
153         RETURN
154      END IF
155*
156*     Compute the L*D*L**H (or U**H*D*U) factorization of A.
157*
158      CALL CPTTRF( N, D, E, INFO )
159      IF( INFO.EQ.0 ) THEN
160*
161*        Solve the system A*X = B, overwriting B with X.
162*
163         CALL CPTTRS( 'Lower', N, NRHS, D, E, B, LDB, INFO )
164      END IF
165      RETURN
166*
167*     End of CPTSV
168*
169      END
170