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: *> \ingroup doubleSYsolve
185: *
186: *> \par Contributors:
187: * ==================
188: *>
189: *> \verbatim
190: *>
191: *> April 2012, Igor Kozachenko,
192: *> Computer Science Division,
193: *> University of California, Berkeley
194: *>
195: *> September 2007, Sven Hammarling, Nicholas J. Higham, Craig Lucas,
196: *> School of Mathematics,
197: *> University of Manchester
198: *>
199: *> \endverbatim
200: *
201: * =====================================================================
202: SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
203: $ LWORK, INFO )
204: *
205: * -- LAPACK driver routine --
206: * -- LAPACK is a software package provided by Univ. of Tennessee, --
207: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
208: *
209: * .. Scalar Arguments ..
210: CHARACTER UPLO
211: INTEGER INFO, LDA, LDB, LWORK, N, NRHS
212: * ..
213: * .. Array Arguments ..
214: INTEGER IPIV( * )
215: DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
216: * ..
217: *
218: * =====================================================================
219: *
220: * .. Local Scalars ..
221: LOGICAL LQUERY
222: INTEGER LWKOPT
223: * ..
224: * .. External Functions ..
225: LOGICAL LSAME
226: EXTERNAL LSAME
227: * ..
228: * .. External Subroutines ..
229: EXTERNAL XERBLA, DSYTRF_ROOK, DSYTRS_ROOK
230: * ..
231: * .. Intrinsic Functions ..
232: INTRINSIC MAX
233: * ..
234: * .. Executable Statements ..
235: *
236: * Test the input parameters.
237: *
238: INFO = 0
239: LQUERY = ( LWORK.EQ.-1 )
240: IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
241: INFO = -1
242: ELSE IF( N.LT.0 ) THEN
243: INFO = -2
244: ELSE IF( NRHS.LT.0 ) THEN
245: INFO = -3
246: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
247: INFO = -5
248: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
249: INFO = -8
250: ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
251: INFO = -10
252: END IF
253: *
254: IF( INFO.EQ.0 ) THEN
255: IF( N.EQ.0 ) THEN
256: LWKOPT = 1
257: ELSE
258: CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
259: LWKOPT = INT( WORK( 1 ) )
260: END IF
261: WORK( 1 ) = LWKOPT
262: END IF
263: *
264: IF( INFO.NE.0 ) THEN
265: CALL XERBLA( 'DSYSV_ROOK ', -INFO )
266: RETURN
267: ELSE IF( LQUERY ) THEN
268: RETURN
269: END IF
270: *
271: * Compute the factorization A = U*D*U**T or A = L*D*L**T.
272: *
273: CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
274: IF( INFO.EQ.0 ) THEN
275: *
276: * Solve the system A*X = B, overwriting B with X.
277: *
278: * Solve with TRS_ROOK ( Use Level 2 BLAS)
279: *
280: CALL DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
281: *
282: END IF
283: *
284: WORK( 1 ) = LWKOPT
285: *
286: RETURN
287: *
288: * End of DSYSV_ROOK
289: *
290: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dsysv_rook.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack