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