LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
csysv_aa_2stage.f
Go to the documentation of this file.
1*> \brief <b> CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY 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 CSYSV_AA_2STAGE + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csysv_aa_2stage.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csysv_aa_2stage.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csysv_aa_2stage.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
22* IPIV, IPIV2, B, LDB, WORK, LWORK,
23* INFO )
24*
25* .. Scalar Arguments ..
26* CHARACTER UPLO
27* INTEGER N, NRHS, LDA, LTB, LDB, LWORK, INFO
28* ..
29* .. Array Arguments ..
30* INTEGER IPIV( * ), IPIV2( * )
31* COMPLEX A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
32* ..
33*
34*> \par Purpose:
35* =============
36*>
37*> \verbatim
38*>
39*> CSYSV_AA_2STAGE computes the solution to a complex system of
40*> linear equations
41*> A * X = B,
42*> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
43*> matrices.
44*>
45*> Aasen's 2-stage algorithm is used to factor A as
46*> A = U**T * T * U, if UPLO = 'U', or
47*> A = L * T * L**T, if UPLO = 'L',
48*> where U (or L) is a product of permutation and unit upper (lower)
49*> triangular matrices, and T is symmetric and band. The matrix T is
50*> then LU-factored with partial pivoting. The factored form of A
51*> is then used to solve the system of equations A * X = B.
52*>
53*> This is the blocked version of the algorithm, calling Level 3 BLAS.
54*> \endverbatim
55*
56* Arguments:
57* ==========
58*
59*> \param[in] UPLO
60*> \verbatim
61*> UPLO is CHARACTER*1
62*> = 'U': Upper triangle of A is stored;
63*> = 'L': Lower triangle of A is stored.
64*> \endverbatim
65*>
66*> \param[in] N
67*> \verbatim
68*> N is INTEGER
69*> The order of the matrix A. N >= 0.
70*> \endverbatim
71*>
72*> \param[in] NRHS
73*> \verbatim
74*> NRHS is INTEGER
75*> The number of right hand sides, i.e., the number of columns
76*> of the matrix B. NRHS >= 0.
77*> \endverbatim
78*>
79*> \param[in,out] A
80*> \verbatim
81*> A is COMPLEX array, dimension (LDA,N)
82*> On entry, the symmetric matrix A. If UPLO = 'U', the leading
83*> N-by-N upper triangular part of A contains the upper
84*> triangular part of the matrix A, and the strictly lower
85*> triangular part of A is not referenced. If UPLO = 'L', the
86*> leading N-by-N lower triangular part of A contains the lower
87*> triangular part of the matrix A, and the strictly upper
88*> triangular part of A is not referenced.
89*>
90*> On exit, L is stored below (or above) the subdiagonal blocks,
91*> when UPLO is 'L' (or 'U').
92*> \endverbatim
93*>
94*> \param[in] LDA
95*> \verbatim
96*> LDA is INTEGER
97*> The leading dimension of the array A. LDA >= max(1,N).
98*> \endverbatim
99*>
100*> \param[out] TB
101*> \verbatim
102*> TB is COMPLEX array, dimension (LTB)
103*> On exit, details of the LU factorization of the band matrix.
104*> \endverbatim
105*>
106*> \param[in] LTB
107*> \verbatim
108*> LTB is INTEGER
109*> The size of the array TB. LTB >= 4*N, internally
110*> used to select NB such that LTB >= (3*NB+1)*N.
111*>
112*> If LTB = -1, then a workspace query is assumed; the
113*> routine only calculates the optimal size of LTB,
114*> returns this value as the first entry of TB, and
115*> no error message related to LTB is issued by XERBLA.
116*> \endverbatim
117*>
118*> \param[out] IPIV
119*> \verbatim
120*> IPIV is INTEGER array, dimension (N)
121*> On exit, it contains the details of the interchanges, i.e.,
122*> the row and column k of A were interchanged with the
123*> row and column IPIV(k).
124*> \endverbatim
125*>
126*> \param[out] IPIV2
127*> \verbatim
128*> IPIV2 is INTEGER array, dimension (N)
129*> On exit, it contains the details of the interchanges, i.e.,
130*> the row and column k of T were interchanged with the
131*> row and column IPIV(k).
132*> \endverbatim
133*>
134*> \param[in,out] B
135*> \verbatim
136*> B is COMPLEX array, dimension (LDB,NRHS)
137*> On entry, the right hand side matrix B.
138*> On exit, the solution matrix X.
139*> \endverbatim
140*>
141*> \param[in] LDB
142*> \verbatim
143*> LDB is INTEGER
144*> The leading dimension of the array B. LDB >= max(1,N).
145*> \endverbatim
146*>
147*> \param[out] WORK
148*> \verbatim
149*> WORK is COMPLEX workspace of size LWORK
150*> \endverbatim
151*>
152*> \param[in] LWORK
153*> \verbatim
154*> LWORK is INTEGER
155*> The size of WORK. LWORK >= N, internally used to select NB
156*> such that LWORK >= N*NB.
157*>
158*> If LWORK = -1, then a workspace query is assumed; the
159*> routine only calculates the optimal size of the WORK array,
160*> returns this value as the first entry of the WORK array, and
161*> no error message related to LWORK is issued by XERBLA.
162*> \endverbatim
163*>
164*> \param[out] INFO
165*> \verbatim
166*> INFO is INTEGER
167*> = 0: successful exit
168*> < 0: if INFO = -i, the i-th argument had an illegal value.
169*> > 0: if INFO = i, band LU factorization failed on i-th column
170*> \endverbatim
171*
172* Authors:
173* ========
174*
175*> \author Univ. of Tennessee
176*> \author Univ. of California Berkeley
177*> \author Univ. of Colorado Denver
178*> \author NAG Ltd.
179*
180*> \ingroup hesv_aa_2stage
181*
182* =====================================================================
183 SUBROUTINE csysv_aa_2stage( UPLO, N, NRHS, A, LDA, TB, LTB,
184 $ IPIV, IPIV2, B, LDB, WORK, LWORK,
185 $ INFO )
186*
187* -- LAPACK computational routine --
188* -- LAPACK is a software package provided by Univ. of Tennessee, --
189* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
190*
191 IMPLICIT NONE
192*
193* .. Scalar Arguments ..
194 CHARACTER UPLO
195 INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
196* ..
197* .. Array Arguments ..
198 INTEGER IPIV( * ), IPIV2( * )
199 COMPLEX A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
200* ..
201*
202* =====================================================================
203*
204* .. Local Scalars ..
205 LOGICAL UPPER, TQUERY, WQUERY
206 INTEGER LWKOPT
207* ..
208* .. External Functions ..
209 LOGICAL LSAME
210 REAL SROUNDUP_LWORK
211 EXTERNAL lsame, sroundup_lwork
212* ..
213* .. External Subroutines ..
214 EXTERNAL csytrf_aa_2stage,
216* ..
217* .. Intrinsic Functions ..
218 INTRINSIC max
219* ..
220* .. Executable Statements ..
221*
222* Test the input parameters.
223*
224 info = 0
225 upper = lsame( uplo, 'U' )
226 wquery = ( lwork.EQ.-1 )
227 tquery = ( ltb.EQ.-1 )
228 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
229 info = -1
230 ELSE IF( n.LT.0 ) THEN
231 info = -2
232 ELSE IF( nrhs.LT.0 ) THEN
233 info = -3
234 ELSE IF( lda.LT.max( 1, n ) ) THEN
235 info = -5
236 ELSE IF( ltb.LT.( 4*n ) .AND. .NOT.tquery ) THEN
237 info = -7
238 ELSE IF( ldb.LT.max( 1, n ) ) THEN
239 info = -11
240 ELSE IF( lwork.LT.n .AND. .NOT.wquery ) THEN
241 info = -13
242 END IF
243*
244 IF( info.EQ.0 ) THEN
245 CALL csytrf_aa_2stage( uplo, n, a, lda, tb, -1, ipiv,
246 $ ipiv2, work, -1, info )
247 lwkopt = int( work(1) )
248 END IF
249*
250 IF( info.NE.0 ) THEN
251 CALL xerbla( 'CSYSV_AA_2STAGE', -info )
252 RETURN
253 ELSE IF( wquery .OR. tquery ) THEN
254 RETURN
255 END IF
256*
257*
258* Compute the factorization A = U**T*T*U or A = L*T*L**T.
259*
260 CALL csytrf_aa_2stage( uplo, n, a, lda, tb, ltb, ipiv, ipiv2,
261 $ work, lwork, info )
262 IF( info.EQ.0 ) THEN
263*
264* Solve the system A*X = B, overwriting B with X.
265*
266 CALL csytrs_aa_2stage( uplo, n, nrhs, a, lda, tb, ltb, ipiv,
267 $ ipiv2, b, ldb, info )
268*
269 END IF
270*
271 work( 1 ) = sroundup_lwork(lwkopt)
272*
273 RETURN
274*
275* End of CSYSV_AA_2STAGE
276*
277 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine csysv_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork, info)
CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
subroutine csytrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
CSYTRF_AA_2STAGE
subroutine csytrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
CSYTRS_AA_2STAGE