LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cppt02.f
Go to the documentation of this file.
1*> \brief \b CPPT02
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CPPT02( UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK,
12* RESID )
13*
14* .. Scalar Arguments ..
15* CHARACTER UPLO
16* INTEGER LDB, LDX, N, NRHS
17* REAL RESID
18* ..
19* .. Array Arguments ..
20* REAL RWORK( * )
21* COMPLEX A( * ), B( LDB, * ), X( LDX, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CPPT02 computes the residual in the solution of a Hermitian system
31*> of linear equations A*x = b when packed storage is used for the
32*> coefficient matrix. The ratio computed is
33*>
34*> RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS),
35*>
36*> where EPS is the machine precision.
37*> \endverbatim
38*
39* Arguments:
40* ==========
41*
42*> \param[in] UPLO
43*> \verbatim
44*> UPLO is CHARACTER*1
45*> Specifies whether the upper or lower triangular part of the
46*> Hermitian matrix A is stored:
47*> = 'U': Upper triangular
48*> = 'L': Lower triangular
49*> \endverbatim
50*>
51*> \param[in] N
52*> \verbatim
53*> N is INTEGER
54*> The number of rows and columns of the matrix A. N >= 0.
55*> \endverbatim
56*>
57*> \param[in] NRHS
58*> \verbatim
59*> NRHS is INTEGER
60*> The number of columns of B, the matrix of right hand sides.
61*> NRHS >= 0.
62*> \endverbatim
63*>
64*> \param[in] A
65*> \verbatim
66*> A is COMPLEX array, dimension (N*(N+1)/2)
67*> The original Hermitian matrix A, stored as a packed
68*> triangular matrix.
69*> \endverbatim
70*>
71*> \param[in] X
72*> \verbatim
73*> X is COMPLEX array, dimension (LDX,NRHS)
74*> The computed solution vectors for the system of linear
75*> equations.
76*> \endverbatim
77*>
78*> \param[in] LDX
79*> \verbatim
80*> LDX is INTEGER
81*> The leading dimension of the array X. LDX >= max(1,N).
82*> \endverbatim
83*>
84*> \param[in,out] B
85*> \verbatim
86*> B is COMPLEX array, dimension (LDB,NRHS)
87*> On entry, the right hand side vectors for the system of
88*> linear equations.
89*> On exit, B is overwritten with the difference B - A*X.
90*> \endverbatim
91*>
92*> \param[in] LDB
93*> \verbatim
94*> LDB is INTEGER
95*> The leading dimension of the array B. LDB >= max(1,N).
96*> \endverbatim
97*>
98*> \param[out] RWORK
99*> \verbatim
100*> RWORK is REAL array, dimension (N)
101*> \endverbatim
102*>
103*> \param[out] RESID
104*> \verbatim
105*> RESID is REAL
106*> The maximum over the number of right hand sides of
107*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
108*> \endverbatim
109*
110* Authors:
111* ========
112*
113*> \author Univ. of Tennessee
114*> \author Univ. of California Berkeley
115*> \author Univ. of Colorado Denver
116*> \author NAG Ltd.
117*
118*> \ingroup complex_lin
119*
120* =====================================================================
121 SUBROUTINE cppt02( UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK,
122 $ RESID )
123*
124* -- LAPACK test routine --
125* -- LAPACK is a software package provided by Univ. of Tennessee, --
126* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128* .. Scalar Arguments ..
129 CHARACTER UPLO
130 INTEGER LDB, LDX, N, NRHS
131 REAL RESID
132* ..
133* .. Array Arguments ..
134 REAL RWORK( * )
135 COMPLEX A( * ), B( LDB, * ), X( LDX, * )
136* ..
137*
138* =====================================================================
139*
140* .. Parameters ..
141 REAL ZERO, ONE
142 parameter( zero = 0.0e+0, one = 1.0e+0 )
143 COMPLEX CONE
144 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
145* ..
146* .. Local Scalars ..
147 INTEGER J
148 REAL ANORM, BNORM, EPS, XNORM
149* ..
150* .. External Functions ..
151 REAL CLANHP, SCASUM, SLAMCH
152 EXTERNAL clanhp, scasum, slamch
153* ..
154* .. External Subroutines ..
155 EXTERNAL chpmv
156* ..
157* .. Intrinsic Functions ..
158 INTRINSIC max
159* ..
160* .. Executable Statements ..
161*
162* Quick exit if N = 0 or NRHS = 0.
163*
164 IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
165 resid = zero
166 RETURN
167 END IF
168*
169* Exit with RESID = 1/EPS if ANORM = 0.
170*
171 eps = slamch( 'Epsilon' )
172 anorm = clanhp( '1', uplo, n, a, rwork )
173 IF( anorm.LE.zero ) THEN
174 resid = one / eps
175 RETURN
176 END IF
177*
178* Compute B - A*X for the matrix of right hand sides B.
179*
180 DO 10 j = 1, nrhs
181 CALL chpmv( uplo, n, -cone, a, x( 1, j ), 1, cone, b( 1, j ),
182 $ 1 )
183 10 CONTINUE
184*
185* Compute the maximum over the number of right hand sides of
186* norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) .
187*
188 resid = zero
189 DO 20 j = 1, nrhs
190 bnorm = scasum( n, b( 1, j ), 1 )
191 xnorm = scasum( n, x( 1, j ), 1 )
192 IF( xnorm.LE.zero ) THEN
193 resid = one / eps
194 ELSE
195 resid = max( resid, ( ( bnorm/anorm )/xnorm )/eps )
196 END IF
197 20 CONTINUE
198*
199 RETURN
200*
201* End of CPPT02
202*
203 END
subroutine cppt02(uplo, n, nrhs, a, x, ldx, b, ldb, rwork, resid)
CPPT02
Definition cppt02.f:123
subroutine chpmv(uplo, n, alpha, ap, x, incx, beta, y, incy)
CHPMV
Definition chpmv.f:149