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