00001 SUBROUTINE DTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, 00002 $ 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 LDA, N 00011 DOUBLE PRECISION RAT, RCOND, RCONDC 00012 * .. 00013 * .. Array Arguments .. 00014 DOUBLE PRECISION A( LDA, * ), WORK( * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * DTRT06 computes a test ratio comparing RCOND (the reciprocal 00021 * condition number of a triangular matrix A) and RCONDC, the estimate 00022 * computed by DTRCON. 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 * DTRCON. 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 * A (input) DOUBLE PRECISION array, dimension (LDA,N) 00052 * The triangular matrix A. If UPLO = 'U', the leading n by n 00053 * upper triangular part of the array A contains the upper 00054 * triangular matrix, and the strictly lower triangular part of 00055 * A is not referenced. If UPLO = 'L', the leading n by n lower 00056 * triangular part of the array A contains the lower triangular 00057 * matrix, and the strictly upper triangular part of A is not 00058 * referenced. If DIAG = 'U', the diagonal elements of A are 00059 * also not referenced and are assumed to be 1. 00060 * 00061 * LDA (input) INTEGER 00062 * The leading dimension of the array A. LDA >= max(1,N). 00063 * 00064 * WORK (workspace) DOUBLE PRECISION array, dimension (N) 00065 * 00066 * RAT (output) DOUBLE PRECISION 00067 * The test ratio. If both RCOND and RCONDC are nonzero, 00068 * RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1. 00069 * If RAT = 0, the two estimates are exactly the same. 00070 * 00071 * ===================================================================== 00072 * 00073 * .. Parameters .. 00074 DOUBLE PRECISION ZERO, ONE 00075 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00076 * .. 00077 * .. Local Scalars .. 00078 DOUBLE PRECISION ANORM, BIGNUM, EPS, RMAX, RMIN, SMLNUM 00079 * .. 00080 * .. External Functions .. 00081 DOUBLE PRECISION DLAMCH, DLANTR 00082 EXTERNAL DLAMCH, DLANTR 00083 * .. 00084 * .. Intrinsic Functions .. 00085 INTRINSIC MAX, MIN 00086 * .. 00087 * .. External Subroutines .. 00088 EXTERNAL DLABAD 00089 * .. 00090 * .. Executable Statements .. 00091 * 00092 EPS = DLAMCH( 'Epsilon' ) 00093 RMAX = MAX( RCOND, RCONDC ) 00094 RMIN = MIN( RCOND, RCONDC ) 00095 * 00096 * Do the easy cases first. 00097 * 00098 IF( RMIN.LT.ZERO ) THEN 00099 * 00100 * Invalid value for RCOND or RCONDC, return 1/EPS. 00101 * 00102 RAT = ONE / EPS 00103 * 00104 ELSE IF( RMIN.GT.ZERO ) THEN 00105 * 00106 * Both estimates are positive, return RMAX/RMIN - 1. 00107 * 00108 RAT = RMAX / RMIN - ONE 00109 * 00110 ELSE IF( RMAX.EQ.ZERO ) THEN 00111 * 00112 * Both estimates zero. 00113 * 00114 RAT = ZERO 00115 * 00116 ELSE 00117 * 00118 * One estimate is zero, the other is non-zero. If the matrix is 00119 * ill-conditioned, return the nonzero estimate multiplied by 00120 * 1/EPS; if the matrix is badly scaled, return the nonzero 00121 * estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum 00122 * element in absolute value in A. 00123 * 00124 SMLNUM = DLAMCH( 'Safe minimum' ) 00125 BIGNUM = ONE / SMLNUM 00126 CALL DLABAD( SMLNUM, BIGNUM ) 00127 ANORM = DLANTR( 'M', UPLO, DIAG, N, N, A, LDA, WORK ) 00128 * 00129 RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) 00130 END IF 00131 * 00132 RETURN 00133 * 00134 * End of DTRT06 00135 * 00136 END
1.7.2