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