LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ctpt02.f
Go to the documentation of this file.
1*> \brief \b CTPT02
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 CTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB,
12* WORK, RWORK, RESID )
13*
14* .. Scalar Arguments ..
15* CHARACTER DIAG, TRANS, UPLO
16* INTEGER LDB, LDX, N, NRHS
17* REAL RESID
18* ..
19* .. Array Arguments ..
20* REAL RWORK( * )
21* COMPLEX AP( * ), B( LDB, * ), WORK( * ), X( LDX, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CTPT02 computes the residual for the computed solution to a
31*> triangular system of linear equations op(A)*X = B, when the
32*> triangular matrix A is stored in packed format. The test ratio is
33*> the maximum over
34*> norm(b - op(A)*x) / ( ||op(A)||_1 * norm(x) * EPS ),
35*> where op(A) = A, A**T, or A**H, b is the column of B, x is the
36*> solution vector, and EPS is the machine epsilon.
37*> \endverbatim
38*
39* Arguments:
40* ==========
41*
42*> \param[in] UPLO
43*> \verbatim
44*> UPLO is CHARACTER*1
45*> Specifies whether the matrix A is upper or lower triangular.
46*> = 'U': Upper triangular
47*> = 'L': Lower triangular
48*> \endverbatim
49*>
50*> \param[in] TRANS
51*> \verbatim
52*> TRANS is CHARACTER*1
53*> Specifies the operation applied to A.
54*> = 'N': A * X = B (No transpose)
55*> = 'T': A**T * X = B (Transpose)
56*> = 'C': A**H * X = B (Conjugate transpose)
57*> \endverbatim
58*>
59*> \param[in] DIAG
60*> \verbatim
61*> DIAG is CHARACTER*1
62*> Specifies whether or not the matrix A is unit triangular.
63*> = 'N': Non-unit triangular
64*> = 'U': Unit triangular
65*> \endverbatim
66*>
67*> \param[in] N
68*> \verbatim
69*> N is INTEGER
70*> The order of the matrix A. N >= 0.
71*> \endverbatim
72*>
73*> \param[in] NRHS
74*> \verbatim
75*> NRHS is INTEGER
76*> The number of right hand sides, i.e., the number of columns
77*> of the matrices X and B. NRHS >= 0.
78*> \endverbatim
79*>
80*> \param[in] AP
81*> \verbatim
82*> AP is COMPLEX array, dimension (N*(N+1)/2)
83*> The upper or lower triangular matrix A, packed columnwise in
84*> a linear array. The j-th column of A is stored in the array
85*> AP as follows:
86*> if UPLO = 'U', AP((j-1)*j/2 + i) = A(i,j) for 1<=i<=j;
87*> if UPLO = 'L',
88*> AP((j-1)*(n-j) + j*(j+1)/2 + i-j) = A(i,j) for j<=i<=n.
89*> \endverbatim
90*>
91*> \param[in] X
92*> \verbatim
93*> X is COMPLEX array, dimension (LDX,NRHS)
94*> The computed solution vectors for the system of linear
95*> equations.
96*> \endverbatim
97*>
98*> \param[in] LDX
99*> \verbatim
100*> LDX is INTEGER
101*> The leading dimension of the array X. LDX >= max(1,N).
102*> \endverbatim
103*>
104*> \param[in] B
105*> \verbatim
106*> B is COMPLEX array, dimension (LDB,NRHS)
107*> The right hand side vectors for the system of linear
108*> equations.
109*> \endverbatim
110*>
111*> \param[in] LDB
112*> \verbatim
113*> LDB is INTEGER
114*> The leading dimension of the array B. LDB >= max(1,N).
115*> \endverbatim
116*>
117*> \param[out] WORK
118*> \verbatim
119*> WORK is COMPLEX array, dimension (N)
120*> \endverbatim
121*>
122*> \param[out] RWORK
123*> \verbatim
124*> RWORK is REAL array, dimension (N)
125*> \endverbatim
126*>
127*> \param[out] RESID
128*> \verbatim
129*> RESID is REAL
130*> The maximum over the number of right hand sides of
131*> norm(op(A)*B - B) / ( norm(op(A)) * norm(X) * EPS ).
132*> \endverbatim
133*
134* Authors:
135* ========
136*
137*> \author Univ. of Tennessee
138*> \author Univ. of California Berkeley
139*> \author Univ. of Colorado Denver
140*> \author NAG Ltd.
141*
142*> \ingroup complex_lin
143*
144* =====================================================================
145 SUBROUTINE ctpt02( UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB,
146 $ WORK, RWORK, RESID )
147*
148* -- LAPACK test routine --
149* -- LAPACK is a software package provided by Univ. of Tennessee, --
150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151*
152* .. Scalar Arguments ..
153 CHARACTER DIAG, TRANS, UPLO
154 INTEGER LDB, LDX, N, NRHS
155 REAL RESID
156* ..
157* .. Array Arguments ..
158 REAL RWORK( * )
159 COMPLEX AP( * ), B( LDB, * ), WORK( * ), X( LDX, * )
160* ..
161*
162* =====================================================================
163*
164* .. Parameters ..
165 REAL ZERO, ONE
166 parameter( zero = 0.0e+0, one = 1.0e+0 )
167* ..
168* .. Local Scalars ..
169 INTEGER J
170 REAL ANORM, BNORM, EPS, XNORM
171* ..
172* .. External Functions ..
173 LOGICAL LSAME
174 REAL CLANTP, SCASUM, SLAMCH
175 EXTERNAL lsame, clantp, scasum, slamch
176* ..
177* .. External Subroutines ..
178 EXTERNAL caxpy, ccopy, ctpmv
179* ..
180* .. Intrinsic Functions ..
181 INTRINSIC cmplx, max
182* ..
183* .. Executable Statements ..
184*
185* Quick exit if N = 0 or NRHS = 0
186*
187 IF( n.LE.0 .OR. nrhs.LE.0 ) THEN
188 resid = zero
189 RETURN
190 END IF
191*
192* Compute the 1-norm of op(A).
193*
194 IF( lsame( trans, 'N' ) ) THEN
195 anorm = clantp( '1', uplo, diag, n, ap, rwork )
196 ELSE
197 anorm = clantp( 'I', uplo, diag, n, ap, rwork )
198 END IF
199*
200* Exit with RESID = 1/EPS if ANORM = 0.
201*
202 eps = slamch( 'Epsilon' )
203 IF( anorm.LE.zero ) THEN
204 resid = one / eps
205 RETURN
206 END IF
207*
208* Compute the maximum over the number of right hand sides of
209* norm(op(A)*X - B) / ( norm(op(A)) * norm(X) * EPS ).
210*
211 resid = zero
212 DO 10 j = 1, nrhs
213 CALL ccopy( n, x( 1, j ), 1, work, 1 )
214 CALL ctpmv( uplo, trans, diag, n, ap, work, 1 )
215 CALL caxpy( n, cmplx( -one ), b( 1, j ), 1, work, 1 )
216 bnorm = scasum( n, work, 1 )
217 xnorm = scasum( n, x( 1, j ), 1 )
218 IF( xnorm.LE.zero ) THEN
219 resid = one / eps
220 ELSE
221 resid = max( resid, ( ( bnorm / anorm ) / xnorm ) / eps )
222 END IF
223 10 CONTINUE
224*
225 RETURN
226*
227* End of CTPT02
228*
229 END
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
Definition: caxpy.f:88
subroutine ctpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
CTPMV
Definition: ctpmv.f:142
subroutine ctpt02(UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, WORK, RWORK, RESID)
CTPT02
Definition: ctpt02.f:147