LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
ctbt06.f
Go to the documentation of this file.
1 *> \brief \b CTBT06
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 CTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB,
12 * RWORK, RAT )
13 *
14 * .. Scalar Arguments ..
15 * CHARACTER DIAG, UPLO
16 * INTEGER KD, LDAB, N
17 * REAL RAT, RCOND, RCONDC
18 * ..
19 * .. Array Arguments ..
20 * REAL RWORK( * )
21 * COMPLEX AB( LDAB, * )
22 * ..
23 *
24 *
25 *> \par Purpose:
26 * =============
27 *>
28 *> \verbatim
29 *>
30 *> CTBT06 computes a test ratio comparing RCOND (the reciprocal
31 *> condition number of a triangular matrix A) and RCONDC, the estimate
32 *> computed by CTBCON. 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 *> CTBCON.
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] KD
78 *> \verbatim
79 *> KD is INTEGER
80 *> The number of superdiagonals or subdiagonals of the
81 *> triangular band matrix A. KD >= 0.
82 *> \endverbatim
83 *>
84 *> \param[in] AB
85 *> \verbatim
86 *> AB is COMPLEX array, dimension (LDAB,N)
87 *> The upper or lower triangular band matrix A, stored in the
88 *> first kd+1 rows of the array. The j-th column of A is stored
89 *> in the j-th column of the array AB as follows:
90 *> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
91 *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
92 *> \endverbatim
93 *>
94 *> \param[in] LDAB
95 *> \verbatim
96 *> LDAB is INTEGER
97 *> The leading dimension of the array AB. LDAB >= KD+1.
98 *> \endverbatim
99 *>
100 *> \param[out] RWORK
101 *> \verbatim
102 *> RWORK is REAL array, dimension (N)
103 *> \endverbatim
104 *>
105 *> \param[out] RAT
106 *> \verbatim
107 *> RAT is REAL
108 *> The test ratio. If both RCOND and RCONDC are nonzero,
109 *> RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
110 *> If RAT = 0, the two estimates are exactly the same.
111 *> \endverbatim
112 *
113 * Authors:
114 * ========
115 *
116 *> \author Univ. of Tennessee
117 *> \author Univ. of California Berkeley
118 *> \author Univ. of Colorado Denver
119 *> \author NAG Ltd.
120 *
121 *> \date November 2011
122 *
123 *> \ingroup complex_lin
124 *
125 * =====================================================================
126  SUBROUTINE ctbt06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB,
127  $ rwork, rat )
128 *
129 * -- LAPACK test routine (version 3.4.0) --
130 * -- LAPACK is a software package provided by Univ. of Tennessee, --
131 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132 * November 2011
133 *
134 * .. Scalar Arguments ..
135  CHARACTER diag, uplo
136  INTEGER kd, ldab, n
137  REAL rat, rcond, rcondc
138 * ..
139 * .. Array Arguments ..
140  REAL rwork( * )
141  COMPLEX ab( ldab, * )
142 * ..
143 *
144 * =====================================================================
145 *
146 * .. Parameters ..
147  REAL zero, one
148  parameter( zero = 0.0e+0, one = 1.0e+0 )
149 * ..
150 * .. Local Scalars ..
151  REAL anorm, bignum, eps, rmax, rmin
152 * ..
153 * .. External Functions ..
154  REAL clantb, slamch
155  EXTERNAL clantb, slamch
156 * ..
157 * .. Intrinsic Functions ..
158  INTRINSIC max, min
159 * ..
160 * .. Executable Statements ..
161 *
162  eps = slamch( 'Epsilon' )
163  rmax = max( rcond, rcondc )
164  rmin = min( rcond, rcondc )
165 *
166 * Do the easy cases first.
167 *
168  IF( rmin.LT.zero ) THEN
169 *
170 * Invalid value for RCOND or RCONDC, return 1/EPS.
171 *
172  rat = one / eps
173 *
174  ELSE IF( rmin.GT.zero ) THEN
175 *
176 * Both estimates are positive, return RMAX/RMIN - 1.
177 *
178  rat = rmax / rmin - one
179 *
180  ELSE IF( rmax.EQ.zero ) THEN
181 *
182 * Both estimates zero.
183 *
184  rat = zero
185 *
186  ELSE
187 *
188 * One estimate is zero, the other is non-zero. If the matrix is
189 * ill-conditioned, return the nonzero estimate multiplied by
190 * 1/EPS; if the matrix is badly scaled, return the nonzero
191 * estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
192 * element in absolute value in A.
193 *
194  bignum = one / slamch( 'Safe minimum' )
195  anorm = clantb( 'M', uplo, diag, n, kd, ab, ldab, rwork )
196 *
197  rat = rmax*( min( bignum / max( one, anorm ), one / eps ) )
198  END IF
199 *
200  return
201 *
202 * End of CTBT06
203 *
204  END