LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ctrt06.f
Go to the documentation of this file.
1*> \brief \b CTRT06
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 CTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK,
12* RAT )
13*
14* .. Scalar Arguments ..
15* CHARACTER DIAG, UPLO
16* INTEGER LDA, N
17* REAL RAT, RCOND, RCONDC
18* ..
19* .. Array Arguments ..
20* REAL RWORK( * )
21* COMPLEX A( LDA, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CTRT06 computes a test ratio comparing RCOND (the reciprocal
31*> condition number of a triangular matrix A) and RCONDC, the estimate
32*> computed by CTRCON. Information about the triangular matrix A is
33*> used if one estimate is zero and the other is non-zero to decide if
34*> underflow in the estimate is justified.
35*> \endverbatim
36*
37* Arguments:
38* ==========
39*
40*> \param[in] RCOND
41*> \verbatim
42*> RCOND is REAL
43*> The estimate of the reciprocal condition number obtained by
44*> forming the explicit inverse of the matrix A and computing
45*> RCOND = 1/( norm(A) * norm(inv(A)) ).
46*> \endverbatim
47*>
48*> \param[in] RCONDC
49*> \verbatim
50*> RCONDC is REAL
51*> The estimate of the reciprocal condition number computed by
52*> CTRCON.
53*> \endverbatim
54*>
55*> \param[in] UPLO
56*> \verbatim
57*> UPLO is CHARACTER
58*> Specifies whether the matrix A is upper or lower triangular.
59*> = 'U': Upper triangular
60*> = 'L': Lower triangular
61*> \endverbatim
62*>
63*> \param[in] DIAG
64*> \verbatim
65*> DIAG is CHARACTER
66*> Specifies whether or not the matrix A is unit triangular.
67*> = 'N': Non-unit triangular
68*> = 'U': Unit triangular
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*> N is INTEGER
74*> The order of the matrix A. N >= 0.
75*> \endverbatim
76*>
77*> \param[in] A
78*> \verbatim
79*> A is COMPLEX array, dimension (LDA,N)
80*> The triangular matrix A. If UPLO = 'U', the leading n by n
81*> upper triangular part of the array A contains the upper
82*> triangular matrix, and the strictly lower triangular part of
83*> A is not referenced. If UPLO = 'L', the leading n by n lower
84*> triangular part of the array A contains the lower triangular
85*> matrix, and the strictly upper triangular part of A is not
86*> referenced. If DIAG = 'U', the diagonal elements of A are
87*> also not referenced and are assumed to be 1.
88*> \endverbatim
89*>
90*> \param[in] LDA
91*> \verbatim
92*> LDA is INTEGER
93*> The leading dimension of the array A. LDA >= max(1,N).
94*> \endverbatim
95*>
96*> \param[out] RWORK
97*> \verbatim
98*> RWORK is REAL array, dimension (N)
99*> \endverbatim
100*>
101*> \param[out] RAT
102*> \verbatim
103*> RAT is REAL
104*> The test ratio. If both RCOND and RCONDC are nonzero,
105*> RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
106*> If RAT = 0, the two estimates are exactly the same.
107*> \endverbatim
108*
109* Authors:
110* ========
111*
112*> \author Univ. of Tennessee
113*> \author Univ. of California Berkeley
114*> \author Univ. of Colorado Denver
115*> \author NAG Ltd.
116*
117*> \ingroup complex_lin
118*
119* =====================================================================
120 SUBROUTINE ctrt06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK,
121 $ RAT )
122*
123* -- LAPACK test routine --
124* -- LAPACK is a software package provided by Univ. of Tennessee, --
125* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
126*
127* .. Scalar Arguments ..
128 CHARACTER DIAG, UPLO
129 INTEGER LDA, N
130 REAL RAT, RCOND, RCONDC
131* ..
132* .. Array Arguments ..
133 REAL RWORK( * )
134 COMPLEX A( LDA, * )
135* ..
136*
137* =====================================================================
138*
139* .. Parameters ..
140 REAL ZERO, ONE
141 parameter( zero = 0.0e+0, one = 1.0e+0 )
142* ..
143* .. Local Scalars ..
144 REAL ANORM, BIGNUM, EPS, RMAX, RMIN
145* ..
146* .. External Functions ..
147 REAL CLANTR, SLAMCH
148 EXTERNAL clantr, slamch
149* ..
150* .. Intrinsic Functions ..
151 INTRINSIC max, min
152* ..
153* .. Executable Statements ..
154*
155 eps = slamch( 'Epsilon' )
156 rmax = max( rcond, rcondc )
157 rmin = min( rcond, rcondc )
158*
159* Do the easy cases first.
160*
161 IF( rmin.LT.zero ) THEN
162*
163* Invalid value for RCOND or RCONDC, return 1/EPS.
164*
165 rat = one / eps
166*
167 ELSE IF( rmin.GT.zero ) THEN
168*
169* Both estimates are positive, return RMAX/RMIN - 1.
170*
171 rat = rmax / rmin - one
172*
173 ELSE IF( rmax.EQ.zero ) THEN
174*
175* Both estimates zero.
176*
177 rat = zero
178*
179 ELSE
180*
181* One estimate is zero, the other is non-zero. If the matrix is
182* ill-conditioned, return the nonzero estimate multiplied by
183* 1/EPS; if the matrix is badly scaled, return the nonzero
184* estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
185* element in absolute value in A.
186*
187 bignum = one / slamch( 'Safe minimum' )
188 anorm = clantr( 'M', uplo, diag, n, n, a, lda, rwork )
189*
190 rat = rmax*( min( bignum / max( one, anorm ), one / eps ) )
191 END IF
192*
193 RETURN
194*
195* End of CTRT06
196*
197 END
subroutine ctrt06(rcond, rcondc, uplo, diag, n, a, lda, rwork, rat)
CTRT06
Definition ctrt06.f:122