00001 /* dtrt06.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 dtrt06_(doublereal *rcond, doublereal *rcondc, char * 00017 uplo, char *diag, integer *n, doublereal *a, integer *lda, doublereal 00018 *work, doublereal *rat) 00019 { 00020 /* System generated locals */ 00021 integer a_dim1, a_offset; 00022 doublereal d__1, d__2; 00023 00024 /* Local variables */ 00025 doublereal eps, rmin, rmax, anorm; 00026 extern /* Subroutine */ int dlabad_(doublereal *, doublereal *); 00027 extern doublereal dlamch_(char *); 00028 doublereal bignum; 00029 extern doublereal dlantr_(char *, char *, char *, integer *, integer *, 00030 doublereal *, integer *, doublereal *); 00031 doublereal smlnum; 00032 00033 00034 /* -- LAPACK test routine (version 3.1) -- */ 00035 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00036 /* November 2006 */ 00037 00038 /* .. Scalar Arguments .. */ 00039 /* .. */ 00040 /* .. Array Arguments .. */ 00041 /* .. */ 00042 00043 /* Purpose */ 00044 /* ======= */ 00045 00046 /* DTRT06 computes a test ratio comparing RCOND (the reciprocal */ 00047 /* condition number of a triangular matrix A) and RCONDC, the estimate */ 00048 /* computed by DTRCON. Information about the triangular matrix A is */ 00049 /* used if one estimate is zero and the other is non-zero to decide if */ 00050 /* underflow in the estimate is justified. */ 00051 00052 /* Arguments */ 00053 /* ========= */ 00054 00055 /* RCOND (input) DOUBLE PRECISION */ 00056 /* The estimate of the reciprocal condition number obtained by */ 00057 /* forming the explicit inverse of the matrix A and computing */ 00058 /* RCOND = 1/( norm(A) * norm(inv(A)) ). */ 00059 00060 /* RCONDC (input) DOUBLE PRECISION */ 00061 /* The estimate of the reciprocal condition number computed by */ 00062 /* DTRCON. */ 00063 00064 /* UPLO (input) CHARACTER */ 00065 /* Specifies whether the matrix A is upper or lower triangular. */ 00066 /* = 'U': Upper triangular */ 00067 /* = 'L': Lower triangular */ 00068 00069 /* DIAG (input) CHARACTER */ 00070 /* Specifies whether or not the matrix A is unit triangular. */ 00071 /* = 'N': Non-unit triangular */ 00072 /* = 'U': Unit triangular */ 00073 00074 /* N (input) INTEGER */ 00075 /* The order of the matrix A. N >= 0. */ 00076 00077 /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */ 00078 /* The triangular matrix A. If UPLO = 'U', the leading n by n */ 00079 /* upper triangular part of the array A contains the upper */ 00080 /* triangular matrix, and the strictly lower triangular part of */ 00081 /* A is not referenced. If UPLO = 'L', the leading n by n lower */ 00082 /* triangular part of the array A contains the lower triangular */ 00083 /* matrix, and the strictly upper triangular part of A is not */ 00084 /* referenced. If DIAG = 'U', the diagonal elements of A are */ 00085 /* also not referenced and are assumed to be 1. */ 00086 00087 /* LDA (input) INTEGER */ 00088 /* The leading dimension of the array A. LDA >= max(1,N). */ 00089 00090 /* WORK (workspace) DOUBLE PRECISION array, dimension (N) */ 00091 00092 /* RAT (output) DOUBLE PRECISION */ 00093 /* The test ratio. If both RCOND and RCONDC are nonzero, */ 00094 /* RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1. */ 00095 /* If RAT = 0, the two estimates are exactly the same. */ 00096 00097 /* ===================================================================== */ 00098 00099 /* .. Parameters .. */ 00100 /* .. */ 00101 /* .. Local Scalars .. */ 00102 /* .. */ 00103 /* .. External Functions .. */ 00104 /* .. */ 00105 /* .. Intrinsic Functions .. */ 00106 /* .. */ 00107 /* .. External Subroutines .. */ 00108 /* .. */ 00109 /* .. Executable Statements .. */ 00110 00111 /* Parameter adjustments */ 00112 a_dim1 = *lda; 00113 a_offset = 1 + a_dim1; 00114 a -= a_offset; 00115 --work; 00116 00117 /* Function Body */ 00118 eps = dlamch_("Epsilon"); 00119 rmax = max(*rcond,*rcondc); 00120 rmin = min(*rcond,*rcondc); 00121 00122 /* Do the easy cases first. */ 00123 00124 if (rmin < 0.) { 00125 00126 /* Invalid value for RCOND or RCONDC, return 1/EPS. */ 00127 00128 *rat = 1. / eps; 00129 00130 } else if (rmin > 0.) { 00131 00132 /* Both estimates are positive, return RMAX/RMIN - 1. */ 00133 00134 *rat = rmax / rmin - 1.; 00135 00136 } else if (rmax == 0.) { 00137 00138 /* Both estimates zero. */ 00139 00140 *rat = 0.; 00141 00142 } else { 00143 00144 /* One estimate is zero, the other is non-zero. If the matrix is */ 00145 /* ill-conditioned, return the nonzero estimate multiplied by */ 00146 /* 1/EPS; if the matrix is badly scaled, return the nonzero */ 00147 /* estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum */ 00148 /* element in absolute value in A. */ 00149 00150 smlnum = dlamch_("Safe minimum"); 00151 bignum = 1. / smlnum; 00152 dlabad_(&smlnum, &bignum); 00153 anorm = dlantr_("M", uplo, diag, n, n, &a[a_offset], lda, &work[1]); 00154 00155 /* Computing MIN */ 00156 d__1 = bignum / max(1.,anorm), d__2 = 1. / eps; 00157 *rat = rmax * min(d__1,d__2); 00158 } 00159 00160 return 0; 00161 00162 /* End of DTRT06 */ 00163 00164 } /* dtrt06_ */