1*> \brief <b> ZSPSV computes the solution to system of linear equations A * X = B for OTHER 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 ZSPSV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zspsv.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zspsv.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zspsv.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            INFO, LDB, N, NRHS
26*       ..
27*       .. Array Arguments ..
28*       INTEGER            IPIV( * )
29*       COMPLEX*16         AP( * ), B( LDB, * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> ZSPSV computes the solution to a complex system of linear equations
39*>    A * X = B,
40*> where A is an N-by-N symmetric matrix stored in packed format and X
41*> and B are N-by-NRHS matrices.
42*>
43*> The diagonal pivoting method is used to factor A as
44*>    A = U * D * U**T,  if UPLO = 'U', or
45*>    A = L * D * L**T,  if UPLO = 'L',
46*> where U (or L) is a product of permutation and unit upper (lower)
47*> triangular matrices, D is symmetric and block diagonal with 1-by-1
48*> and 2-by-2 diagonal blocks.  The factored form of A is then used to
49*> solve the system of equations A * X = B.
50*> \endverbatim
51*
52*  Arguments:
53*  ==========
54*
55*> \param[in] UPLO
56*> \verbatim
57*>          UPLO is CHARACTER*1
58*>          = 'U':  Upper triangle of A is stored;
59*>          = 'L':  Lower triangle of A is stored.
60*> \endverbatim
61*>
62*> \param[in] N
63*> \verbatim
64*>          N is INTEGER
65*>          The number of linear equations, i.e., the order of the
66*>          matrix A.  N >= 0.
67*> \endverbatim
68*>
69*> \param[in] NRHS
70*> \verbatim
71*>          NRHS is INTEGER
72*>          The number of right hand sides, i.e., the number of columns
73*>          of the matrix B.  NRHS >= 0.
74*> \endverbatim
75*>
76*> \param[in,out] AP
77*> \verbatim
78*>          AP is COMPLEX*16 array, dimension (N*(N+1)/2)
79*>          On entry, the upper or lower triangle of the symmetric matrix
80*>          A, packed columnwise in a linear array.  The j-th column of A
81*>          is stored in the array AP as follows:
82*>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
83*>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
84*>          See below for further details.
85*>
86*>          On exit, the block diagonal matrix D and the multipliers used
87*>          to obtain the factor U or L from the factorization
88*>          A = U*D*U**T or A = L*D*L**T as computed by ZSPTRF, stored as
89*>          a packed triangular matrix in the same storage format as A.
90*> \endverbatim
91*>
92*> \param[out] IPIV
93*> \verbatim
94*>          IPIV is INTEGER array, dimension (N)
95*>          Details of the interchanges and the block structure of D, as
96*>          determined by ZSPTRF.  If IPIV(k) > 0, then rows and columns
97*>          k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
98*>          diagonal block.  If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
99*>          then rows and columns k-1 and -IPIV(k) were interchanged and
100*>          D(k-1:k,k-1:k) is a 2-by-2 diagonal block.  If UPLO = 'L' and
101*>          IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
102*>          -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
103*>          diagonal block.
104*> \endverbatim
105*>
106*> \param[in,out] B
107*> \verbatim
108*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
109*>          On entry, the N-by-NRHS right hand side matrix B.
110*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
111*> \endverbatim
112*>
113*> \param[in] LDB
114*> \verbatim
115*>          LDB is INTEGER
116*>          The leading dimension of the array B.  LDB >= max(1,N).
117*> \endverbatim
118*>
119*> \param[out] INFO
120*> \verbatim
121*>          INFO is INTEGER
122*>          = 0:  successful exit
123*>          < 0:  if INFO = -i, the i-th argument had an illegal value
124*>          > 0:  if INFO = i, D(i,i) is exactly zero.  The factorization
125*>                has been completed, but the block diagonal matrix D is
126*>                exactly singular, so the solution could not be
127*>                computed.
128*> \endverbatim
129*
130*  Authors:
131*  ========
132*
133*> \author Univ. of Tennessee
134*> \author Univ. of California Berkeley
135*> \author Univ. of Colorado Denver
136*> \author NAG Ltd.
137*
138*> \date November 2011
139*
140*> \ingroup complex16OTHERsolve
141*
142*> \par Further Details:
143*  =====================
144*>
145*> \verbatim
146*>
147*>  The packed storage scheme is illustrated by the following example
148*>  when N = 4, UPLO = 'U':
149*>
150*>  Two-dimensional storage of the symmetric matrix A:
151*>
152*>     a11 a12 a13 a14
153*>         a22 a23 a24
154*>             a33 a34     (aij = aji)
155*>                 a44
156*>
157*>  Packed storage of the upper triangle of A:
158*>
159*>  AP = [ a11, a12, a22, a13, a23, a33, a14, a24, a34, a44 ]
160*> \endverbatim
161*>
162*  =====================================================================
163      SUBROUTINE ZSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
164*
165*  -- LAPACK driver routine (version 3.4.0) --
166*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
167*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
168*     November 2011
169*
170*     .. Scalar Arguments ..
171      CHARACTER          UPLO
172      INTEGER            INFO, LDB, N, NRHS
173*     ..
174*     .. Array Arguments ..
175      INTEGER            IPIV( * )
176      COMPLEX*16         AP( * ), B( LDB, * )
177*     ..
178*
179*  =====================================================================
180*
181*     .. External Functions ..
182      LOGICAL            LSAME
183      EXTERNAL           LSAME
184*     ..
185*     .. External Subroutines ..
186      EXTERNAL           XERBLA, ZSPTRF, ZSPTRS
187*     ..
188*     .. Intrinsic Functions ..
189      INTRINSIC          MAX
190*     ..
191*     .. Executable Statements ..
192*
193*     Test the input parameters.
194*
195      INFO = 0
196      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
197         INFO = -1
198      ELSE IF( N.LT.0 ) THEN
199         INFO = -2
200      ELSE IF( NRHS.LT.0 ) THEN
201         INFO = -3
202      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
203         INFO = -7
204      END IF
205      IF( INFO.NE.0 ) THEN
206         CALL XERBLA( 'ZSPSV ', -INFO )
207         RETURN
208      END IF
209*
210*     Compute the factorization A = U*D*U**T or A = L*D*L**T.
211*
212      CALL ZSPTRF( UPLO, N, AP, IPIV, INFO )
213      IF( INFO.EQ.0 ) THEN
214*
215*        Solve the system A*X = B, overwriting B with X.
216*
217         CALL ZSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO )
218*
219      END IF
220      RETURN
221*
222*     End of ZSPSV
223*
224      END
225