Annotation of rpl/lapack/lapack/zhesv.f, revision 1.8
1.1 bertrand 1: SUBROUTINE ZHESV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
2: $ LWORK, INFO )
3: *
1.7 bertrand 4: * -- LAPACK driver routine (version 3.3.0) --
1.1 bertrand 5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.7 bertrand 7: * November 2010
1.1 bertrand 8: *
9: * .. Scalar Arguments ..
10: CHARACTER UPLO
11: INTEGER INFO, LDA, LDB, LWORK, N, NRHS
12: * ..
13: * .. Array Arguments ..
14: INTEGER IPIV( * )
15: COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
16: * ..
17: *
18: * Purpose
19: * =======
20: *
21: * ZHESV computes the solution to a complex system of linear equations
22: * A * X = B,
23: * where A is an N-by-N Hermitian matrix and X and B are N-by-NRHS
24: * matrices.
25: *
26: * The diagonal pivoting method is used to factor A as
27: * A = U * D * U**H, if UPLO = 'U', or
28: * A = L * D * L**H, if UPLO = 'L',
29: * where U (or L) is a product of permutation and unit upper (lower)
30: * triangular matrices, and D is Hermitian and block diagonal with
31: * 1-by-1 and 2-by-2 diagonal blocks. The factored form of A is then
32: * used to solve the system of equations A * X = B.
33: *
34: * Arguments
35: * =========
36: *
37: * UPLO (input) CHARACTER*1
38: * = 'U': Upper triangle of A is stored;
39: * = 'L': Lower triangle of A is stored.
40: *
41: * N (input) INTEGER
42: * The number of linear equations, i.e., the order of the
43: * matrix A. N >= 0.
44: *
45: * NRHS (input) INTEGER
46: * The number of right hand sides, i.e., the number of columns
47: * of the matrix B. NRHS >= 0.
48: *
49: * A (input/output) COMPLEX*16 array, dimension (LDA,N)
50: * On entry, the Hermitian matrix A. If UPLO = 'U', the leading
51: * N-by-N upper triangular part of A contains the upper
52: * triangular part of the matrix A, and the strictly lower
53: * triangular part of A is not referenced. If UPLO = 'L', the
54: * leading N-by-N lower triangular part of A contains the lower
55: * triangular part of the matrix A, and the strictly upper
56: * triangular part of A is not referenced.
57: *
58: * On exit, if INFO = 0, the block diagonal matrix D and the
59: * multipliers used to obtain the factor U or L from the
60: * factorization A = U*D*U**H or A = L*D*L**H as computed by
61: * ZHETRF.
62: *
63: * LDA (input) INTEGER
64: * The leading dimension of the array A. LDA >= max(1,N).
65: *
66: * IPIV (output) INTEGER array, dimension (N)
67: * Details of the interchanges and the block structure of D, as
68: * determined by ZHETRF. If IPIV(k) > 0, then rows and columns
69: * k and IPIV(k) were interchanged, and D(k,k) is a 1-by-1
70: * diagonal block. If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0,
71: * then rows and columns k-1 and -IPIV(k) were interchanged and
72: * D(k-1:k,k-1:k) is a 2-by-2 diagonal block. If UPLO = 'L' and
73: * IPIV(k) = IPIV(k+1) < 0, then rows and columns k+1 and
74: * -IPIV(k) were interchanged and D(k:k+1,k:k+1) is a 2-by-2
75: * diagonal block.
76: *
77: * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
78: * On entry, the N-by-NRHS right hand side matrix B.
79: * On exit, if INFO = 0, the N-by-NRHS solution matrix X.
80: *
81: * LDB (input) INTEGER
82: * The leading dimension of the array B. LDB >= max(1,N).
83: *
84: * WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
85: * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
86: *
87: * LWORK (input) INTEGER
88: * The length of WORK. LWORK >= 1, and for best performance
89: * LWORK >= max(1,N*NB), where NB is the optimal blocksize for
90: * ZHETRF.
91: *
92: * If LWORK = -1, then a workspace query is assumed; the routine
93: * only calculates the optimal size of the WORK array, returns
94: * this value as the first entry of the WORK array, and no error
95: * message related to LWORK is issued by XERBLA.
96: *
97: * INFO (output) INTEGER
98: * = 0: successful exit
99: * < 0: if INFO = -i, the i-th argument had an illegal value
100: * > 0: if INFO = i, D(i,i) is exactly zero. The factorization
101: * has been completed, but the block diagonal matrix D is
102: * exactly singular, so the solution could not be computed.
103: *
104: * =====================================================================
105: *
106: * .. Local Scalars ..
107: LOGICAL LQUERY
108: INTEGER LWKOPT, NB
109: * ..
110: * .. External Functions ..
111: LOGICAL LSAME
112: INTEGER ILAENV
113: EXTERNAL LSAME, ILAENV
114: * ..
115: * .. External Subroutines ..
1.7 bertrand 116: EXTERNAL XERBLA, ZHETRF, ZHETRS2
1.1 bertrand 117: * ..
118: * .. Intrinsic Functions ..
119: INTRINSIC MAX
120: * ..
121: * .. Executable Statements ..
122: *
123: * Test the input parameters.
124: *
125: INFO = 0
126: LQUERY = ( LWORK.EQ.-1 )
127: IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
128: INFO = -1
129: ELSE IF( N.LT.0 ) THEN
130: INFO = -2
131: ELSE IF( NRHS.LT.0 ) THEN
132: INFO = -3
133: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
134: INFO = -5
135: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
136: INFO = -8
137: ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
138: INFO = -10
139: END IF
140: *
141: IF( INFO.EQ.0 ) THEN
142: IF( N.EQ.0 ) THEN
143: LWKOPT = 1
144: ELSE
145: NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
146: LWKOPT = N*NB
147: END IF
148: WORK( 1 ) = LWKOPT
149: END IF
150: *
151: IF( INFO.NE.0 ) THEN
152: CALL XERBLA( 'ZHESV ', -INFO )
153: RETURN
154: ELSE IF( LQUERY ) THEN
155: RETURN
156: END IF
157: *
158: * Compute the factorization A = U*D*U' or A = L*D*L'.
159: *
160: CALL ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
161: IF( INFO.EQ.0 ) THEN
162: *
163: * Solve the system A*X = B, overwriting B with X.
164: *
1.7 bertrand 165: CALL ZHETRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO )
1.1 bertrand 166: *
167: END IF
168: *
169: WORK( 1 ) = LWKOPT
170: *
171: RETURN
172: *
173: * End of ZHESV
174: *
175: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zhesv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack