1ZCPOSV(1) LAPACK PROTOTYPE driver routine (version 3.2) ZCPOSV(1)
2
3
4
6 ZCPOSV - computes the solution to a complex system of linear equations
7 A * X = B,
8
10 SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
11
12 + SWORK, RWORK, ITER, INFO )
13
14 CHARACTER UPLO
15
16 INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS
17
18 DOUBLE PRECISION RWORK( * )
19
20 COMPLEX SWORK( * )
21
22 COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( N, * ),
23
24 + X( LDX, * )
25
27 ZCPOSV computes the solution to a complex system of linear equations
28 A * X = B, where A is an N-by-N Hermitian positive definite matrix
29 and X and B are N-by-NRHS matrices.
30 ZCPOSV first attempts to factorize the matrix in COMPLEX and use this
31 factorization within an iterative refinement procedure to produce a
32 solution with COMPLEX*16 normwise backward error quality (see below).
33 If the approach fails the method switches to a COMPLEX*16 factorization
34 and solve.
35 The iterative refinement is not going to be a winning strategy if the
36 ratio COMPLEX performance over COMPLEX*16 performance is too small. A
37 reasonable strategy should take the number of right-hand sides and the
38 size of the matrix into account. This might be done with a call to
39 ILAENV in the future. Up to now, we always try iterative refinement.
40 The iterative refinement process is stopped if
41 ITER > ITERMAX
42 or for all the RHS we have:
43 RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX
44 where
45 o ITER is the number of the current iteration in the iterative
46 refinement process
47 o RNRM is the infinity-norm of the residual
48 o XNRM is the infinity-norm of the solution
49 o ANRM is the infinity-operator-norm of the matrix A
50 o EPS is the machine epsilon returned by DLAMCH('Epsilon') The
51 value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00
52 respectively.
53
55 UPLO (input) CHARACTER
56 = 'U': Upper triangle of A is stored;
57 = 'L': Lower triangle of A is stored.
58
59 N (input) INTEGER
60 The number of linear equations, i.e., the order of the matrix
61 A. N >= 0.
62
63 NRHS (input) INTEGER
64 The number of right hand sides, i.e., the number of columns of
65 the matrix B. NRHS >= 0.
66
67 A (input or input/ouptut) COMPLEX*16 array,
68 dimension (LDA,N) On entry, the Hermitian matrix A. If UPLO =
69 'U', the leading N-by-N upper triangular part of A contains the
70 upper triangular part of the matrix A, and the strictly lower
71 triangular part of A is not referenced. If UPLO = 'L', the
72 leading N-by-N lower triangular part of A contains the lower
73 triangular part of the matrix A, and the strictly upper trian‐
74 gular part of A is not referenced. Note that the imaginary
75 parts of the diagonal elements need not be set and are assumed
76 to be zero. On exit, if iterative refinement has been success‐
77 fully used (INFO.EQ.0 and ITER.GE.0, see description below),
78 then A is unchanged, if double precision factorization has been
79 used (INFO.EQ.0 and ITER.LT.0, see description below), then the
80 array A contains the factor U or L from the Cholesky factoriza‐
81 tion A = U**H*U or A = L*L**H.
82
83 LDA (input) INTEGER
84 The leading dimension of the array A. LDA >= max(1,N).
85
86 B (input) COMPLEX*16 array, dimension (LDB,NRHS)
87 The N-by-NRHS right hand side matrix B.
88
89 LDB (input) INTEGER
90 The leading dimension of the array B. LDB >= max(1,N).
91
92 X (output) COMPLEX*16 array, dimension (LDX,NRHS)
93 If INFO = 0, the N-by-NRHS solution matrix X.
94
95 LDX (input) INTEGER
96 The leading dimension of the array X. LDX >= max(1,N).
97
98 WORK (workspace) COMPLEX*16 array, dimension (N*NRHS)
99 This array is used to hold the residual vectors.
100
101 SWORK (workspace) COMPLEX array, dimension (N*(N+NRHS))
102 This array is used to use the single precision matrix and the
103 right-hand sides or solutions in single precision.
104
105 RWORK (workspace) DOUBLE PRECISION array, dimension (N)
106
107 ITER (output) INTEGER
108 < 0: iterative refinement has failed, COMPLEX*16 factorization
109 has been performed -1 : the routine fell back to full precision
110 for implementation- or machine-specific reasons -2 : narrowing
111 the precision induced an overflow, the routine fell back to
112 full precision -3 : failure of CPOTRF
113 -31: stop the iterative refinement after the 30th iterations >
114 0: iterative refinement has been sucessfully used. Returns the
115 number of iterations
116
117 INFO (output) INTEGER
118 = 0: successful exit
119 < 0: if INFO = -i, the i-th argument had an illegal value
120 > 0: if INFO = i, the leading minor of order i of (COMPLEX*16)
121 A is not positive definite, so the factorization could not be
122 completed, and the solution has not been computed. =========
123
124
125
126 LAPACK PROTOTYPE driver routine (Nvoevresmiboenr 32.020)8 ZCPOSV(1)