Annotation of rpl/lapack/lapack/dsysv_aa_2stage.f, revision 1.2
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: *> \date November 2017
183: *
184: *> \ingroup doubleSYsolve
185: *
186: * =====================================================================
187: SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
188: $ IPIV, IPIV2, B, LDB, WORK, LWORK,
189: $ INFO )
190: *
191: * -- LAPACK computational routine (version 3.8.0) --
192: * -- LAPACK is a software package provided by Univ. of Tennessee, --
193: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
194: * November 2017
195: *
196: IMPLICIT NONE
197: *
198: * .. Scalar Arguments ..
199: CHARACTER UPLO
200: INTEGER N, NRHS, LDA, LDB, LTB, LWORK, INFO
201: * ..
202: * .. Array Arguments ..
203: INTEGER IPIV( * ), IPIV2( * )
204: DOUBLE PRECISION A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
205: * ..
206: *
207: * =====================================================================
208: *
209: * .. Local Scalars ..
210: LOGICAL UPPER, TQUERY, WQUERY
211: INTEGER LWKOPT
212: * ..
213: * .. External Functions ..
214: LOGICAL LSAME
215: EXTERNAL LSAME
216: * ..
217: * .. External Subroutines ..
218: EXTERNAL DSYTRF_AA_2STAGE, DSYTRS_AA_2STAGE,
219: $ XERBLA
220: * ..
221: * .. Intrinsic Functions ..
222: INTRINSIC MAX
223: * ..
224: * .. Executable Statements ..
225: *
226: * Test the input parameters.
227: *
228: INFO = 0
229: UPPER = LSAME( UPLO, 'U' )
230: WQUERY = ( LWORK.EQ.-1 )
231: TQUERY = ( LTB.EQ.-1 )
232: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
233: INFO = -1
234: ELSE IF( N.LT.0 ) THEN
235: INFO = -2
236: ELSE IF( NRHS.LT.0 ) THEN
237: INFO = -3
238: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
239: INFO = -5
1.2 ! bertrand 240: ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
! 241: INFO = -7
1.1 bertrand 242: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
243: INFO = -11
1.2 ! bertrand 244: ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
! 245: INFO = -13
1.1 bertrand 246: END IF
247: *
248: IF( INFO.EQ.0 ) THEN
249: CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
250: $ IPIV2, WORK, -1, INFO )
251: LWKOPT = INT( WORK(1) )
252: END IF
253: *
254: IF( INFO.NE.0 ) THEN
255: CALL XERBLA( 'DSYSV_AA_2STAGE', -INFO )
256: RETURN
257: ELSE IF( WQUERY .OR. TQUERY ) THEN
258: RETURN
259: END IF
260: *
261: *
1.2 ! bertrand 262: * Compute the factorization A = U**T*T*U or A = L*T*L**T.
1.1 bertrand 263: *
264: CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
265: $ WORK, LWORK, INFO )
266: IF( INFO.EQ.0 ) THEN
267: *
268: * Solve the system A*X = B, overwriting B with X.
269: *
270: CALL DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
271: $ IPIV2, B, LDB, INFO )
272: *
273: END IF
274: *
275: WORK( 1 ) = LWKOPT
276: *
277: RETURN
278: *
279: * End of DSYSV_AA_2STAGE
280: *
281: END
CVSweb interface <joel.bertrand@systella.fr>