LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
dsysv_rook.f
Go to the documentation of this file.
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.7.0) --
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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dsysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: dsysv_rook.f:206
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
Definition: dsytrs_rook.f:138
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_ROOK
Definition: dsytrf_rook.f:210