00001 /* ctbt06.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int ctbt06_(real *rcond, real *rcondc, char *uplo, char * 00017 diag, integer *n, integer *kd, complex *ab, integer *ldab, real * 00018 rwork, real *rat) 00019 { 00020 /* System generated locals */ 00021 integer ab_dim1, ab_offset; 00022 real r__1, r__2; 00023 00024 /* Local variables */ 00025 real eps, rmin, rmax, anorm; 00026 extern doublereal clantb_(char *, char *, char *, integer *, integer *, 00027 complex *, integer *, real *), slamch_( 00028 char *); 00029 real bignum; 00030 00031 00032 /* -- LAPACK test routine (version 3.1) -- */ 00033 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00034 /* November 2006 */ 00035 00036 /* .. Scalar Arguments .. */ 00037 /* .. */ 00038 /* .. Array Arguments .. */ 00039 /* .. */ 00040 00041 /* Purpose */ 00042 /* ======= */ 00043 00044 /* CTBT06 computes a test ratio comparing RCOND (the reciprocal */ 00045 /* condition number of a triangular matrix A) and RCONDC, the estimate */ 00046 /* computed by CTBCON. Information about the triangular matrix A is */ 00047 /* used if one estimate is zero and the other is non-zero to decide if */ 00048 /* underflow in the estimate is justified. */ 00049 00050 /* Arguments */ 00051 /* ========= */ 00052 00053 /* RCOND (input) REAL */ 00054 /* The estimate of the reciprocal condition number obtained by */ 00055 /* forming the explicit inverse of the matrix A and computing */ 00056 /* RCOND = 1/( norm(A) * norm(inv(A)) ). */ 00057 00058 /* RCONDC (input) REAL */ 00059 /* The estimate of the reciprocal condition number computed by */ 00060 /* CTBCON. */ 00061 00062 /* UPLO (input) CHARACTER */ 00063 /* Specifies whether the matrix A is upper or lower triangular. */ 00064 /* = 'U': Upper triangular */ 00065 /* = 'L': Lower triangular */ 00066 00067 /* DIAG (input) CHARACTER */ 00068 /* Specifies whether or not the matrix A is unit triangular. */ 00069 /* = 'N': Non-unit triangular */ 00070 /* = 'U': Unit triangular */ 00071 00072 /* N (input) INTEGER */ 00073 /* The order of the matrix A. N >= 0. */ 00074 00075 /* KD (input) INTEGER */ 00076 /* The number of superdiagonals or subdiagonals of the */ 00077 /* triangular band matrix A. KD >= 0. */ 00078 00079 /* AB (input) COMPLEX array, dimension (LDAB,N) */ 00080 /* The upper or lower triangular band matrix A, stored in the */ 00081 /* first kd+1 rows of the array. The j-th column of A is stored */ 00082 /* in the j-th column of the array AB as follows: */ 00083 /* if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; */ 00084 /* if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). */ 00085 00086 /* LDAB (input) INTEGER */ 00087 /* The leading dimension of the array AB. LDAB >= KD+1. */ 00088 00089 /* RWORK (workspace) REAL array, dimension (N) */ 00090 00091 /* RAT (output) REAL */ 00092 /* The test ratio. If both RCOND and RCONDC are nonzero, */ 00093 /* RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1. */ 00094 /* If RAT = 0, the two estimates are exactly the same. */ 00095 00096 /* ===================================================================== */ 00097 00098 /* .. Parameters .. */ 00099 /* .. */ 00100 /* .. Local Scalars .. */ 00101 /* .. */ 00102 /* .. External Functions .. */ 00103 /* .. */ 00104 /* .. Intrinsic Functions .. */ 00105 /* .. */ 00106 /* .. Executable Statements .. */ 00107 00108 /* Parameter adjustments */ 00109 ab_dim1 = *ldab; 00110 ab_offset = 1 + ab_dim1; 00111 ab -= ab_offset; 00112 --rwork; 00113 00114 /* Function Body */ 00115 eps = slamch_("Epsilon"); 00116 rmax = dmax(*rcond,*rcondc); 00117 rmin = dmin(*rcond,*rcondc); 00118 00119 /* Do the easy cases first. */ 00120 00121 if (rmin < 0.f) { 00122 00123 /* Invalid value for RCOND or RCONDC, return 1/EPS. */ 00124 00125 *rat = 1.f / eps; 00126 00127 } else if (rmin > 0.f) { 00128 00129 /* Both estimates are positive, return RMAX/RMIN - 1. */ 00130 00131 *rat = rmax / rmin - 1.f; 00132 00133 } else if (rmax == 0.f) { 00134 00135 /* Both estimates zero. */ 00136 00137 *rat = 0.f; 00138 00139 } else { 00140 00141 /* One estimate is zero, the other is non-zero. If the matrix is */ 00142 /* ill-conditioned, return the nonzero estimate multiplied by */ 00143 /* 1/EPS; if the matrix is badly scaled, return the nonzero */ 00144 /* estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum */ 00145 /* element in absolute value in A. */ 00146 00147 bignum = 1.f / slamch_("Safe minimum"); 00148 anorm = clantb_("M", uplo, diag, n, kd, &ab[ab_offset], ldab, &rwork[ 00149 1]); 00150 00151 /* Computing MIN */ 00152 r__1 = bignum / dmax(1.f,anorm), r__2 = 1.f / eps; 00153 *rat = rmax * dmin(r__1,r__2); 00154 } 00155 00156 return 0; 00157 00158 /* End of CTBT06 */ 00159 00160 } /* ctbt06_ */