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