1*> \brief \b CPPTRS
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CPPTRS + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpptrs.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpptrs.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpptrs.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            INFO, LDB, N, NRHS
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX            AP( * ), B( LDB, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CPPTRS solves a system of linear equations A*X = B with a Hermitian
38*> positive definite matrix A in packed storage using the Cholesky
39*> factorization A = U**H*U or A = L*L**H computed by CPPTRF.
40*> \endverbatim
41*
42*  Arguments:
43*  ==========
44*
45*> \param[in] UPLO
46*> \verbatim
47*>          UPLO is CHARACTER*1
48*>          = 'U':  Upper triangle of A is stored;
49*>          = 'L':  Lower triangle of A is stored.
50*> \endverbatim
51*>
52*> \param[in] N
53*> \verbatim
54*>          N is INTEGER
55*>          The order of the matrix A.  N >= 0.
56*> \endverbatim
57*>
58*> \param[in] NRHS
59*> \verbatim
60*>          NRHS is INTEGER
61*>          The number of right hand sides, i.e., the number of columns
62*>          of the matrix B.  NRHS >= 0.
63*> \endverbatim
64*>
65*> \param[in] AP
66*> \verbatim
67*>          AP is COMPLEX array, dimension (N*(N+1)/2)
68*>          The triangular factor U or L from the Cholesky factorization
69*>          A = U**H*U or A = L*L**H, packed columnwise in a linear
70*>          array.  The j-th column of U or L is stored in the array AP
71*>          as follows:
72*>          if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
73*>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
74*> \endverbatim
75*>
76*> \param[in,out] B
77*> \verbatim
78*>          B is COMPLEX array, dimension (LDB,NRHS)
79*>          On entry, the right hand side matrix B.
80*>          On exit, the solution matrix X.
81*> \endverbatim
82*>
83*> \param[in] LDB
84*> \verbatim
85*>          LDB is INTEGER
86*>          The leading dimension of the array B.  LDB >= max(1,N).
87*> \endverbatim
88*>
89*> \param[out] INFO
90*> \verbatim
91*>          INFO is INTEGER
92*>          = 0:  successful exit
93*>          < 0:  if INFO = -i, the i-th argument had an illegal value
94*> \endverbatim
95*
96*  Authors:
97*  ========
98*
99*> \author Univ. of Tennessee
100*> \author Univ. of California Berkeley
101*> \author Univ. of Colorado Denver
102*> \author NAG Ltd.
103*
104*> \date November 2011
105*
106*> \ingroup complexOTHERcomputational
107*
108*  =====================================================================
109      SUBROUTINE CPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
110*
111*  -- LAPACK computational routine (version 3.4.0) --
112*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
113*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
114*     November 2011
115*
116*     .. Scalar Arguments ..
117      CHARACTER          UPLO
118      INTEGER            INFO, LDB, N, NRHS
119*     ..
120*     .. Array Arguments ..
121      COMPLEX            AP( * ), B( LDB, * )
122*     ..
123*
124*  =====================================================================
125*
126*     .. Local Scalars ..
127      LOGICAL            UPPER
128      INTEGER            I
129*     ..
130*     .. External Functions ..
131      LOGICAL            LSAME
132      EXTERNAL           LSAME
133*     ..
134*     .. External Subroutines ..
135      EXTERNAL           CTPSV, XERBLA
136*     ..
137*     .. Intrinsic Functions ..
138      INTRINSIC          MAX
139*     ..
140*     .. Executable Statements ..
141*
142*     Test the input parameters.
143*
144      INFO = 0
145      UPPER = LSAME( UPLO, 'U' )
146      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
147         INFO = -1
148      ELSE IF( N.LT.0 ) THEN
149         INFO = -2
150      ELSE IF( NRHS.LT.0 ) THEN
151         INFO = -3
152      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
153         INFO = -6
154      END IF
155      IF( INFO.NE.0 ) THEN
156         CALL XERBLA( 'CPPTRS', -INFO )
157         RETURN
158      END IF
159*
160*     Quick return if possible
161*
162      IF( N.EQ.0 .OR. NRHS.EQ.0 )
163     $   RETURN
164*
165      IF( UPPER ) THEN
166*
167*        Solve A*X = B where A = U**H * U.
168*
169         DO 10 I = 1, NRHS
170*
171*           Solve U**H *X = B, overwriting B with X.
172*
173            CALL CTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', N,
174     $                  AP, B( 1, I ), 1 )
175*
176*           Solve U*X = B, overwriting B with X.
177*
178            CALL CTPSV( 'Upper', 'No transpose', 'Non-unit', N, AP,
179     $                  B( 1, I ), 1 )
180   10    CONTINUE
181      ELSE
182*
183*        Solve A*X = B where A = L * L**H.
184*
185         DO 20 I = 1, NRHS
186*
187*           Solve L*Y = B, overwriting B with X.
188*
189            CALL CTPSV( 'Lower', 'No transpose', 'Non-unit', N, AP,
190     $                  B( 1, I ), 1 )
191*
192*           Solve L**H *X = Y, overwriting B with X.
193*
194            CALL CTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', N,
195     $                  AP, B( 1, I ), 1 )
196   20    CONTINUE
197      END IF
198*
199      RETURN
200*
201*     End of CPPTRS
202*
203      END
204