1 SUBROUTINE CTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB,
2 $ RWORK, RAT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER DIAG, UPLO
10 INTEGER KD, LDAB, N
11 REAL RAT, RCOND, RCONDC
12 * ..
13 * .. Array Arguments ..
14 REAL RWORK( * )
15 COMPLEX AB( LDAB, * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * CTBT06 computes a test ratio comparing RCOND (the reciprocal
22 * condition number of a triangular matrix A) and RCONDC, the estimate
23 * computed by CTBCON. Information about the triangular matrix A is
24 * used if one estimate is zero and the other is non-zero to decide if
25 * underflow in the estimate is justified.
26 *
27 * Arguments
28 * =========
29 *
30 * RCOND (input) REAL
31 * The estimate of the reciprocal condition number obtained by
32 * forming the explicit inverse of the matrix A and computing
33 * RCOND = 1/( norm(A) * norm(inv(A)) ).
34 *
35 * RCONDC (input) REAL
36 * The estimate of the reciprocal condition number computed by
37 * CTBCON.
38 *
39 * UPLO (input) CHARACTER
40 * Specifies whether the matrix A is upper or lower triangular.
41 * = 'U': Upper triangular
42 * = 'L': Lower triangular
43 *
44 * DIAG (input) CHARACTER
45 * Specifies whether or not the matrix A is unit triangular.
46 * = 'N': Non-unit triangular
47 * = 'U': Unit triangular
48 *
49 * N (input) INTEGER
50 * The order of the matrix A. N >= 0.
51 *
52 * KD (input) INTEGER
53 * The number of superdiagonals or subdiagonals of the
54 * triangular band matrix A. KD >= 0.
55 *
56 * AB (input) COMPLEX array, dimension (LDAB,N)
57 * The upper or lower triangular band matrix A, stored in the
58 * first kd+1 rows of the array. The j-th column of A is stored
59 * in the j-th column of the array AB as follows:
60 * if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
61 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
62 *
63 * LDAB (input) INTEGER
64 * The leading dimension of the array AB. LDAB >= KD+1.
65 *
66 * RWORK (workspace) REAL array, dimension (N)
67 *
68 * RAT (output) REAL
69 * The test ratio. If both RCOND and RCONDC are nonzero,
70 * RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
71 * If RAT = 0, the two estimates are exactly the same.
72 *
73 * =====================================================================
74 *
75 * .. Parameters ..
76 REAL ZERO, ONE
77 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
78 * ..
79 * .. Local Scalars ..
80 REAL ANORM, BIGNUM, EPS, RMAX, RMIN
81 * ..
82 * .. External Functions ..
83 REAL CLANTB, SLAMCH
84 EXTERNAL CLANTB, SLAMCH
85 * ..
86 * .. Intrinsic Functions ..
87 INTRINSIC MAX, MIN
88 * ..
89 * .. Executable Statements ..
90 *
91 EPS = SLAMCH( 'Epsilon' )
92 RMAX = MAX( RCOND, RCONDC )
93 RMIN = MIN( RCOND, RCONDC )
94 *
95 * Do the easy cases first.
96 *
97 IF( RMIN.LT.ZERO ) THEN
98 *
99 * Invalid value for RCOND or RCONDC, return 1/EPS.
100 *
101 RAT = ONE / EPS
102 *
103 ELSE IF( RMIN.GT.ZERO ) THEN
104 *
105 * Both estimates are positive, return RMAX/RMIN - 1.
106 *
107 RAT = RMAX / RMIN - ONE
108 *
109 ELSE IF( RMAX.EQ.ZERO ) THEN
110 *
111 * Both estimates zero.
112 *
113 RAT = ZERO
114 *
115 ELSE
116 *
117 * One estimate is zero, the other is non-zero. If the matrix is
118 * ill-conditioned, return the nonzero estimate multiplied by
119 * 1/EPS; if the matrix is badly scaled, return the nonzero
120 * estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
121 * element in absolute value in A.
122 *
123 BIGNUM = ONE / SLAMCH( 'Safe minimum' )
124 ANORM = CLANTB( 'M', UPLO, DIAG, N, KD, AB, LDAB, RWORK )
125 *
126 RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
127 END IF
128 *
129 RETURN
130 *
131 * End of CTBT06
132 *
133 END
2 $ RWORK, RAT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER DIAG, UPLO
10 INTEGER KD, LDAB, N
11 REAL RAT, RCOND, RCONDC
12 * ..
13 * .. Array Arguments ..
14 REAL RWORK( * )
15 COMPLEX AB( LDAB, * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * CTBT06 computes a test ratio comparing RCOND (the reciprocal
22 * condition number of a triangular matrix A) and RCONDC, the estimate
23 * computed by CTBCON. Information about the triangular matrix A is
24 * used if one estimate is zero and the other is non-zero to decide if
25 * underflow in the estimate is justified.
26 *
27 * Arguments
28 * =========
29 *
30 * RCOND (input) REAL
31 * The estimate of the reciprocal condition number obtained by
32 * forming the explicit inverse of the matrix A and computing
33 * RCOND = 1/( norm(A) * norm(inv(A)) ).
34 *
35 * RCONDC (input) REAL
36 * The estimate of the reciprocal condition number computed by
37 * CTBCON.
38 *
39 * UPLO (input) CHARACTER
40 * Specifies whether the matrix A is upper or lower triangular.
41 * = 'U': Upper triangular
42 * = 'L': Lower triangular
43 *
44 * DIAG (input) CHARACTER
45 * Specifies whether or not the matrix A is unit triangular.
46 * = 'N': Non-unit triangular
47 * = 'U': Unit triangular
48 *
49 * N (input) INTEGER
50 * The order of the matrix A. N >= 0.
51 *
52 * KD (input) INTEGER
53 * The number of superdiagonals or subdiagonals of the
54 * triangular band matrix A. KD >= 0.
55 *
56 * AB (input) COMPLEX array, dimension (LDAB,N)
57 * The upper or lower triangular band matrix A, stored in the
58 * first kd+1 rows of the array. The j-th column of A is stored
59 * in the j-th column of the array AB as follows:
60 * if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
61 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
62 *
63 * LDAB (input) INTEGER
64 * The leading dimension of the array AB. LDAB >= KD+1.
65 *
66 * RWORK (workspace) REAL array, dimension (N)
67 *
68 * RAT (output) REAL
69 * The test ratio. If both RCOND and RCONDC are nonzero,
70 * RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
71 * If RAT = 0, the two estimates are exactly the same.
72 *
73 * =====================================================================
74 *
75 * .. Parameters ..
76 REAL ZERO, ONE
77 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
78 * ..
79 * .. Local Scalars ..
80 REAL ANORM, BIGNUM, EPS, RMAX, RMIN
81 * ..
82 * .. External Functions ..
83 REAL CLANTB, SLAMCH
84 EXTERNAL CLANTB, SLAMCH
85 * ..
86 * .. Intrinsic Functions ..
87 INTRINSIC MAX, MIN
88 * ..
89 * .. Executable Statements ..
90 *
91 EPS = SLAMCH( 'Epsilon' )
92 RMAX = MAX( RCOND, RCONDC )
93 RMIN = MIN( RCOND, RCONDC )
94 *
95 * Do the easy cases first.
96 *
97 IF( RMIN.LT.ZERO ) THEN
98 *
99 * Invalid value for RCOND or RCONDC, return 1/EPS.
100 *
101 RAT = ONE / EPS
102 *
103 ELSE IF( RMIN.GT.ZERO ) THEN
104 *
105 * Both estimates are positive, return RMAX/RMIN - 1.
106 *
107 RAT = RMAX / RMIN - ONE
108 *
109 ELSE IF( RMAX.EQ.ZERO ) THEN
110 *
111 * Both estimates zero.
112 *
113 RAT = ZERO
114 *
115 ELSE
116 *
117 * One estimate is zero, the other is non-zero. If the matrix is
118 * ill-conditioned, return the nonzero estimate multiplied by
119 * 1/EPS; if the matrix is badly scaled, return the nonzero
120 * estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
121 * element in absolute value in A.
122 *
123 BIGNUM = ONE / SLAMCH( 'Safe minimum' )
124 ANORM = CLANTB( 'M', UPLO, DIAG, N, KD, AB, LDAB, RWORK )
125 *
126 RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
127 END IF
128 *
129 RETURN
130 *
131 * End of CTBT06
132 *
133 END