1*> \brief \b SPPTRS
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SPPTRS + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spptrs.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spptrs.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spptrs.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SPPTRS( 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*       REAL               AP( * ), B( LDB, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> SPPTRS solves a system of linear equations A*X = B with a symmetric
38*> positive definite matrix A in packed storage using the Cholesky
39*> factorization A = U**T*U or A = L*L**T computed by SPPTRF.
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 REAL array, dimension (N*(N+1)/2)
68*>          The triangular factor U or L from the Cholesky factorization
69*>          A = U**T*U or A = L*L**T, 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 REAL 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*> \ingroup realOTHERcomputational
105*
106*  =====================================================================
107      SUBROUTINE SPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO )
108*
109*  -- LAPACK computational routine --
110*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
111*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112*
113*     .. Scalar Arguments ..
114      CHARACTER          UPLO
115      INTEGER            INFO, LDB, N, NRHS
116*     ..
117*     .. Array Arguments ..
118      REAL               AP( * ), B( LDB, * )
119*     ..
120*
121*  =====================================================================
122*
123*     .. Local Scalars ..
124      LOGICAL            UPPER
125      INTEGER            I
126*     ..
127*     .. External Functions ..
128      LOGICAL            LSAME
129      EXTERNAL           LSAME
130*     ..
131*     .. External Subroutines ..
132      EXTERNAL           STPSV, XERBLA
133*     ..
134*     .. Intrinsic Functions ..
135      INTRINSIC          MAX
136*     ..
137*     .. Executable Statements ..
138*
139*     Test the input parameters.
140*
141      INFO = 0
142      UPPER = LSAME( UPLO, 'U' )
143      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
144         INFO = -1
145      ELSE IF( N.LT.0 ) THEN
146         INFO = -2
147      ELSE IF( NRHS.LT.0 ) THEN
148         INFO = -3
149      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
150         INFO = -6
151      END IF
152      IF( INFO.NE.0 ) THEN
153         CALL XERBLA( 'SPPTRS', -INFO )
154         RETURN
155      END IF
156*
157*     Quick return if possible
158*
159      IF( N.EQ.0 .OR. NRHS.EQ.0 )
160     $   RETURN
161*
162      IF( UPPER ) THEN
163*
164*        Solve A*X = B where A = U**T * U.
165*
166         DO 10 I = 1, NRHS
167*
168*           Solve U**T *X = B, overwriting B with X.
169*
170            CALL STPSV( 'Upper', 'Transpose', 'Non-unit', N, AP,
171     $                  B( 1, I ), 1 )
172*
173*           Solve U*X = B, overwriting B with X.
174*
175            CALL STPSV( 'Upper', 'No transpose', 'Non-unit', N, AP,
176     $                  B( 1, I ), 1 )
177   10    CONTINUE
178      ELSE
179*
180*        Solve A*X = B where A = L * L**T.
181*
182         DO 20 I = 1, NRHS
183*
184*           Solve L*Y = B, overwriting B with X.
185*
186            CALL STPSV( 'Lower', 'No transpose', 'Non-unit', N, AP,
187     $                  B( 1, I ), 1 )
188*
189*           Solve L**T *X = Y, overwriting B with X.
190*
191            CALL STPSV( 'Lower', 'Transpose', 'Non-unit', N, AP,
192     $                  B( 1, I ), 1 )
193   20    CONTINUE
194      END IF
195*
196      RETURN
197*
198*     End of SPPTRS
199*
200      END
201