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