1: *> \brief \b ZHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the bounded Bunch-Kaufman ("rook") diagonal pivoting method
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download ZHESV_ROOK + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhesv_rook.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhesv_rook.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhesv_rook.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZHESV_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: * COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
31: * ..
32: *
33: *
34: *> \par Purpose:
35: * =============
36: *>
37: *> \verbatim
38: *>
39: *> ZHESV_ROOK computes the solution to a complex system of linear equations
40: *> A * X = B,
41: *> where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
42: *> matrices.
43: *>
44: *> The bounded Bunch-Kaufman ("rook") diagonal pivoting method is used
45: *> 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 Hermitian and block diagonal with
50: *> 1-by-1 and 2-by-2 diagonal blocks.
51: *>
52: *> ZHETRF_ROOK is called to compute the factorization of a complex
53: *> Hermition 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 ZHETRS_ROOK (uses BLAS 2).
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 COMPLEX*16 array, dimension (LDA,N)
87: *> On entry, the Hermitian 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**H or A = L*D*L**H as computed by
98: *> ZHETRF_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: *>
112: *> If UPLO = 'U':
113: *> Only the last KB elements of IPIV are set.
114: *>
115: *> If IPIV(k) > 0, then rows and columns k and IPIV(k) were
116: *> interchanged and D(k,k) is a 1-by-1 diagonal block.
117: *>
118: *> If IPIV(k) < 0 and IPIV(k-1) < 0, then rows and
119: *> columns k and -IPIV(k) were interchanged and rows and
120: *> columns k-1 and -IPIV(k-1) were inerchaged,
121: *> D(k-1:k,k-1:k) is a 2-by-2 diagonal block.
122: *>
123: *> If UPLO = 'L':
124: *> Only the first KB elements of IPIV are set.
125: *>
126: *> If IPIV(k) > 0, then rows and columns k and IPIV(k)
127: *> were interchanged and D(k,k) is a 1-by-1 diagonal block.
128: *>
129: *> If IPIV(k) < 0 and IPIV(k+1) < 0, then rows and
130: *> columns k and -IPIV(k) were interchanged and rows and
131: *> columns k+1 and -IPIV(k+1) were inerchaged,
132: *> D(k:k+1,k:k+1) is a 2-by-2 diagonal block.
133: *> \endverbatim
134: *>
135: *> \param[in,out] B
136: *> \verbatim
137: *> B is COMPLEX*16 array, dimension (LDB,NRHS)
138: *> On entry, the N-by-NRHS right hand side matrix B.
139: *> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
140: *> \endverbatim
141: *>
142: *> \param[in] LDB
143: *> \verbatim
144: *> LDB is INTEGER
145: *> The leading dimension of the array B. LDB >= max(1,N).
146: *> \endverbatim
147: *>
148: *> \param[out] WORK
149: *> \verbatim
150: *> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
151: *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
152: *> \endverbatim
153: *>
154: *> \param[in] LWORK
155: *> \verbatim
156: *> LWORK is INTEGER
157: *> The length of WORK. LWORK >= 1, and for best performance
158: *> LWORK >= max(1,N*NB), where NB is the optimal blocksize for
159: *> ZHETRF_ROOK.
160: *> for LWORK < N, TRS will be done with Level BLAS 2
161: *> for LWORK >= N, TRS will be done with Level BLAS 3
162: *>
163: *> If LWORK = -1, then a workspace query is assumed; the routine
164: *> only calculates the optimal size of the WORK array, returns
165: *> this value as the first entry of the WORK array, and no error
166: *> message related to LWORK is issued by XERBLA.
167: *> \endverbatim
168: *>
169: *> \param[out] INFO
170: *> \verbatim
171: *> INFO is INTEGER
172: *> = 0: successful exit
173: *> < 0: if INFO = -i, the i-th argument had an illegal value
174: *> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
175: *> has been completed, but the block diagonal matrix D is
176: *> exactly singular, so the solution could not be computed.
177: *> \endverbatim
178: *
179: * Authors:
180: * ========
181: *
182: *> \author Univ. of Tennessee
183: *> \author Univ. of California Berkeley
184: *> \author Univ. of Colorado Denver
185: *> \author NAG Ltd.
186: *
187: *> \ingroup complex16HEsolve
188: *>
189: *> \verbatim
190: *>
191: *> November 2013, 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: * =====================================================================
203: SUBROUTINE ZHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
204: $ LWORK, INFO )
205: *
206: * -- LAPACK driver routine --
207: * -- LAPACK is a software package provided by Univ. of Tennessee, --
208: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
209: *
210: * .. Scalar Arguments ..
211: CHARACTER UPLO
212: INTEGER INFO, LDA, LDB, LWORK, N, NRHS
213: * ..
214: * .. Array Arguments ..
215: INTEGER IPIV( * )
216: COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
217: * ..
218: *
219: * =====================================================================
220: *
221: * .. Local Scalars ..
222: LOGICAL LQUERY
223: INTEGER LWKOPT, NB
224: * ..
225: * .. External Functions ..
226: LOGICAL LSAME
227: INTEGER ILAENV
228: EXTERNAL LSAME, ILAENV
229: * ..
230: * .. External Subroutines ..
231: EXTERNAL XERBLA, ZHETRF_ROOK, ZHETRS_ROOK
232: * ..
233: * .. Intrinsic Functions ..
234: INTRINSIC MAX
235: * ..
236: * .. Executable Statements ..
237: *
238: * Test the input parameters.
239: *
240: INFO = 0
241: LQUERY = ( LWORK.EQ.-1 )
242: IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
243: INFO = -1
244: ELSE IF( N.LT.0 ) THEN
245: INFO = -2
246: ELSE IF( NRHS.LT.0 ) THEN
247: INFO = -3
248: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
249: INFO = -5
250: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
251: INFO = -8
252: ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
253: INFO = -10
254: END IF
255: *
256: IF( INFO.EQ.0 ) THEN
257: IF( N.EQ.0 ) THEN
258: LWKOPT = 1
259: ELSE
260: NB = ILAENV( 1, 'ZHETRF_ROOK', UPLO, N, -1, -1, -1 )
261: LWKOPT = N*NB
262: END IF
263: WORK( 1 ) = LWKOPT
264: END IF
265: *
266: IF( INFO.NE.0 ) THEN
267: CALL XERBLA( 'ZHESV_ROOK ', -INFO )
268: RETURN
269: ELSE IF( LQUERY ) THEN
270: RETURN
271: END IF
272: *
273: * Compute the factorization A = U*D*U**H or A = L*D*L**H.
274: *
275: CALL ZHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
276: IF( INFO.EQ.0 ) THEN
277: *
278: * Solve the system A*X = B, overwriting B with X.
279: *
280: * Solve with TRS ( Use Level BLAS 2)
281: *
282: CALL ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
283: *
284: END IF
285: *
286: WORK( 1 ) = LWKOPT
287: *
288: RETURN
289: *
290: * End of ZHESV_ROOK
291: *
292: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zhesv_rook.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack