LAPACK 3.3.0
|
00001 SUBROUTINE CTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, 00002 $ RWORK, RAT ) 00003 * 00004 * -- LAPACK test routine (version 3.1) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER DIAG, UPLO 00010 INTEGER KD, LDAB, N 00011 REAL RAT, RCOND, RCONDC 00012 * .. 00013 * .. Array Arguments .. 00014 REAL RWORK( * ) 00015 COMPLEX AB( LDAB, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CTBT06 computes a test ratio comparing RCOND (the reciprocal 00022 * condition number of a triangular matrix A) and RCONDC, the estimate 00023 * computed by CTBCON. Information about the triangular matrix A is 00024 * used if one estimate is zero and the other is non-zero to decide if 00025 * underflow in the estimate is justified. 00026 * 00027 * Arguments 00028 * ========= 00029 * 00030 * RCOND (input) REAL 00031 * The estimate of the reciprocal condition number obtained by 00032 * forming the explicit inverse of the matrix A and computing 00033 * RCOND = 1/( norm(A) * norm(inv(A)) ). 00034 * 00035 * RCONDC (input) REAL 00036 * The estimate of the reciprocal condition number computed by 00037 * CTBCON. 00038 * 00039 * UPLO (input) CHARACTER 00040 * Specifies whether the matrix A is upper or lower triangular. 00041 * = 'U': Upper triangular 00042 * = 'L': Lower triangular 00043 * 00044 * DIAG (input) CHARACTER 00045 * Specifies whether or not the matrix A is unit triangular. 00046 * = 'N': Non-unit triangular 00047 * = 'U': Unit triangular 00048 * 00049 * N (input) INTEGER 00050 * The order of the matrix A. N >= 0. 00051 * 00052 * KD (input) INTEGER 00053 * The number of superdiagonals or subdiagonals of the 00054 * triangular band matrix A. KD >= 0. 00055 * 00056 * AB (input) COMPLEX array, dimension (LDAB,N) 00057 * The upper or lower triangular band matrix A, stored in the 00058 * first kd+1 rows of the array. The j-th column of A is stored 00059 * in the j-th column of the array AB as follows: 00060 * if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 00061 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 00062 * 00063 * LDAB (input) INTEGER 00064 * The leading dimension of the array AB. LDAB >= KD+1. 00065 * 00066 * RWORK (workspace) REAL array, dimension (N) 00067 * 00068 * RAT (output) REAL 00069 * The test ratio. If both RCOND and RCONDC are nonzero, 00070 * RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1. 00071 * If RAT = 0, the two estimates are exactly the same. 00072 * 00073 * ===================================================================== 00074 * 00075 * .. Parameters .. 00076 REAL ZERO, ONE 00077 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00078 * .. 00079 * .. Local Scalars .. 00080 REAL ANORM, BIGNUM, EPS, RMAX, RMIN 00081 * .. 00082 * .. External Functions .. 00083 REAL CLANTB, SLAMCH 00084 EXTERNAL CLANTB, SLAMCH 00085 * .. 00086 * .. Intrinsic Functions .. 00087 INTRINSIC MAX, MIN 00088 * .. 00089 * .. Executable Statements .. 00090 * 00091 EPS = SLAMCH( 'Epsilon' ) 00092 RMAX = MAX( RCOND, RCONDC ) 00093 RMIN = MIN( RCOND, RCONDC ) 00094 * 00095 * Do the easy cases first. 00096 * 00097 IF( RMIN.LT.ZERO ) THEN 00098 * 00099 * Invalid value for RCOND or RCONDC, return 1/EPS. 00100 * 00101 RAT = ONE / EPS 00102 * 00103 ELSE IF( RMIN.GT.ZERO ) THEN 00104 * 00105 * Both estimates are positive, return RMAX/RMIN - 1. 00106 * 00107 RAT = RMAX / RMIN - ONE 00108 * 00109 ELSE IF( RMAX.EQ.ZERO ) THEN 00110 * 00111 * Both estimates zero. 00112 * 00113 RAT = ZERO 00114 * 00115 ELSE 00116 * 00117 * One estimate is zero, the other is non-zero. If the matrix is 00118 * ill-conditioned, return the nonzero estimate multiplied by 00119 * 1/EPS; if the matrix is badly scaled, return the nonzero 00120 * estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum 00121 * element in absolute value in A. 00122 * 00123 BIGNUM = ONE / SLAMCH( 'Safe minimum' ) 00124 ANORM = CLANTB( 'M', UPLO, DIAG, N, KD, AB, LDAB, RWORK ) 00125 * 00126 RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) 00127 END IF 00128 * 00129 RETURN 00130 * 00131 * End of CTBT06 00132 * 00133 END