File:
[local] /
rpl /
lapack /
lapack /
dsysv_rook.f
Revision
1.2:
download - view:
text,
annotated -
select for diffs -
revision graph
Mon Jan 27 09:28:28 2014 UTC (10 years, 7 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_24,
rpl-4_1_23,
rpl-4_1_22,
rpl-4_1_21,
rpl-4_1_20,
rpl-4_1_19,
rpl-4_1_18,
rpl-4_1_17,
HEAD
Cohérence.
1: *> \brief <b> DSYSV_ROOK 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 DSYSV_ROOK + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv_rook.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv_rook.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv_rook.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
22: * LWORK, INFO )
23: *
24: * .. Scalar Arguments ..
25: * CHARACTER UPLO
26: * INTEGER INFO, LDA, LDB, LWORK, N, NRHS
27: * ..
28: * .. Array Arguments ..
29: * INTEGER IPIV( * )
30: * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
31: * ..
32: *
33: *
34: *> \par Purpose:
35: * =============
36: *>
37: *> \verbatim
38: *>
39: *> DSYSV_ROOK computes the solution to a real system of linear
40: *> 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: *> The diagonal pivoting method is used to factor A as
46: *> A = U * D * U**T, if UPLO = 'U', or
47: *> A = L * D * L**T, if UPLO = 'L',
48: *> where U (or L) is a product of permutation and unit upper (lower)
49: *> triangular matrices, and D is symmetric and block diagonal with
50: *> 1-by-1 and 2-by-2 diagonal blocks.
51: *>
52: *> DSYTRF_ROOK is called to compute the factorization of a real
53: *> symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal
54: *> pivoting method.
55: *>
56: *> The factored form of A is then used to solve the system
57: *> of equations A * X = B by calling DSYTRS_ROOK.
58: *> \endverbatim
59: *
60: * Arguments:
61: * ==========
62: *
63: *> \param[in] UPLO
64: *> \verbatim
65: *> UPLO is CHARACTER*1
66: *> = 'U': Upper triangle of A is stored;
67: *> = 'L': Lower triangle of A is stored.
68: *> \endverbatim
69: *>
70: *> \param[in] N
71: *> \verbatim
72: *> N is INTEGER
73: *> The number of linear equations, i.e., the order of the
74: *> matrix A. N >= 0.
75: *> \endverbatim
76: *>
77: *> \param[in] NRHS
78: *> \verbatim
79: *> NRHS is INTEGER
80: *> The number of right hand sides, i.e., the number of columns
81: *> of the matrix B. NRHS >= 0.
82: *> \endverbatim
83: *>
84: *> \param[in,out] A
85: *> \verbatim
86: *> A is DOUBLE PRECISION array, dimension (LDA,N)
87: *> On entry, the symmetric matrix A. If UPLO = 'U', the leading
88: *> N-by-N upper triangular part of A contains the upper
89: *> triangular part of the matrix A, and the strictly lower
90: *> triangular part of A is not referenced. If UPLO = 'L', the
91: *> leading N-by-N lower triangular part of A contains the lower
92: *> triangular part of the matrix A, and the strictly upper
93: *> triangular part of A is not referenced.
94: *>
95: *> On exit, if INFO = 0, the block diagonal matrix D and the
96: *> multipliers used to obtain the factor U or L from the
97: *> factorization A = U*D*U**T or A = L*D*L**T as computed by
98: *> DSYTRF_ROOK.
99: *> \endverbatim
100: *>
101: *> \param[in] LDA
102: *> \verbatim
103: *> LDA is INTEGER
104: *> The leading dimension of the array A. LDA >= max(1,N).
105: *> \endverbatim
106: *>
107: *> \param[out] IPIV
108: *> \verbatim
109: *> IPIV is INTEGER array, dimension (N)
110: *> Details of the interchanges and the block structure of D,
111: *> as determined by DSYTRF_ROOK.
112: *>
113: *> If UPLO = 'U':
114: *> If IPIV(k) > 0, then rows and columns k and IPIV(k)
115: *> were interchanged and D(k,k) is a 1-by-1 diagonal block.
116: *>
117: *> If IPIV(k) < 0 and IPIV(k-1) < 0, then rows and
118: *> columns k and -IPIV(k) were interchanged and rows and
119: *> columns k-1 and -IPIV(k-1) were inerchaged,
120: *> D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
121: *>
122: *> If UPLO = 'L':
123: *> If IPIV(k) > 0, then rows and columns k and IPIV(k)
124: *> were interchanged and D(k,k) is a 1-by-1 diagonal block.
125: *>
126: *> If IPIV(k) < 0 and IPIV(k+1) < 0, then rows and
127: *> columns k and -IPIV(k) were interchanged and rows and
128: *> columns k+1 and -IPIV(k+1) were inerchaged,
129: *> D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
130: *> \endverbatim
131: *>
132: *> \param[in,out] B
133: *> \verbatim
134: *> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
135: *> On entry, the N-by-NRHS right hand side matrix B.
136: *> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
137: *> \endverbatim
138: *>
139: *> \param[in] LDB
140: *> \verbatim
141: *> LDB is INTEGER
142: *> The leading dimension of the array B. LDB >= max(1,N).
143: *> \endverbatim
144: *>
145: *> \param[out] WORK
146: *> \verbatim
147: *> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
148: *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
149: *> \endverbatim
150: *>
151: *> \param[in] LWORK
152: *> \verbatim
153: *> LWORK is INTEGER
154: *> The length of WORK. LWORK >= 1, and for best performance
155: *> LWORK >= max(1,N*NB), where NB is the optimal blocksize for
156: *> DSYTRF_ROOK.
157: *>
158: *> TRS will be done with Level 2 BLAS
159: *>
160: *> If LWORK = -1, then a workspace query is assumed; the routine
161: *> only calculates the optimal size of the WORK array, returns
162: *> this value as the first entry of the WORK array, and no error
163: *> 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, D(i,i) is exactly zero. The factorization
172: *> has been completed, but the block diagonal matrix D is
173: *> exactly singular, so the solution could not be computed.
174: *> \endverbatim
175: *
176: * Authors:
177: * ========
178: *
179: *> \author Univ. of Tennessee
180: *> \author Univ. of California Berkeley
181: *> \author Univ. of Colorado Denver
182: *> \author NAG Ltd.
183: *
184: *> \date April 2012
185: *
186: *> \ingroup doubleSYsolve
187: *
188: *> \par Contributors:
189: * ==================
190: *>
191: *> \verbatim
192: *>
193: *> April 2012, Igor Kozachenko,
194: *> Computer Science Division,
195: *> University of California, Berkeley
196: *>
197: *> September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
198: *> School of Mathematics,
199: *> University of Manchester
200: *>
201: *> \endverbatim
202: *
203: * =====================================================================
204: SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
205: $ LWORK, INFO )
206: *
207: * -- LAPACK driver routine (version 3.4.1) --
208: * -- LAPACK is a software package provided by Univ. of Tennessee, --
209: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
210: * April 2012
211: *
212: * .. Scalar Arguments ..
213: CHARACTER UPLO
214: INTEGER INFO, LDA, LDB, LWORK, N, NRHS
215: * ..
216: * .. Array Arguments ..
217: INTEGER IPIV( * )
218: DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
219: * ..
220: *
221: * =====================================================================
222: *
223: * .. Local Scalars ..
224: LOGICAL LQUERY
225: INTEGER LWKOPT
226: * ..
227: * .. External Functions ..
228: LOGICAL LSAME
229: EXTERNAL LSAME
230: * ..
231: * .. External Subroutines ..
232: EXTERNAL XERBLA, DSYTRF_ROOK, DSYTRS_ROOK
233: * ..
234: * .. Intrinsic Functions ..
235: INTRINSIC MAX
236: * ..
237: * .. Executable Statements ..
238: *
239: * Test the input parameters.
240: *
241: INFO = 0
242: LQUERY = ( LWORK.EQ.-1 )
243: IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
244: INFO = -1
245: ELSE IF( N.LT.0 ) THEN
246: INFO = -2
247: ELSE IF( NRHS.LT.0 ) THEN
248: INFO = -3
249: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
250: INFO = -5
251: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
252: INFO = -8
253: ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
254: INFO = -10
255: END IF
256: *
257: IF( INFO.EQ.0 ) THEN
258: IF( N.EQ.0 ) THEN
259: LWKOPT = 1
260: ELSE
261: CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
262: LWKOPT = WORK(1)
263: END IF
264: WORK( 1 ) = LWKOPT
265: END IF
266: *
267: IF( INFO.NE.0 ) THEN
268: CALL XERBLA( 'DSYSV_ROOK ', -INFO )
269: RETURN
270: ELSE IF( LQUERY ) THEN
271: RETURN
272: END IF
273: *
274: * Compute the factorization A = U*D*U**T or A = L*D*L**T.
275: *
276: CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
277: IF( INFO.EQ.0 ) THEN
278: *
279: * Solve the system A*X = B, overwriting B with X.
280: *
281: * Solve with TRS_ROOK ( Use Level 2 BLAS)
282: *
283: CALL DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
284: *
285: END IF
286: *
287: WORK( 1 ) = LWKOPT
288: *
289: RETURN
290: *
291: * End of DSYSV_ROOK
292: *
293: END
CVSweb interface <joel.bertrand@systella.fr>