ctpt06.c
Go to the documentation of this file.
00001 /* ctpt06.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 ctpt06_(real *rcond, real *rcondc, char *uplo, char *
00017         diag, integer *n, complex *ap, real *rwork, real *rat)
00018 {
00019     /* System generated locals */
00020     real r__1, r__2;
00021 
00022     /* Local variables */
00023     real eps, rmin, rmax, anorm;
00024     extern doublereal slamch_(char *);
00025     real bignum;
00026     extern doublereal clantp_(char *, char *, char *, integer *, complex *, 
00027             real *);
00028 
00029 
00030 /*  -- LAPACK test routine (version 3.1) -- */
00031 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00032 /*     November 2006 */
00033 
00034 /*     .. Scalar Arguments .. */
00035 /*     .. */
00036 /*     .. Array Arguments .. */
00037 /*     .. */
00038 
00039 /*  Purpose */
00040 /*  ======= */
00041 
00042 /*  CTPT06 computes a test ratio comparing RCOND (the reciprocal */
00043 /*  condition number of the triangular matrix A) and RCONDC, the estimate */
00044 /*  computed by CTPCON.  Information about the triangular matrix is used */
00045 /*  if one estimate is zero and the other is non-zero to decide if */
00046 /*  underflow in the estimate is justified. */
00047 
00048 /*  Arguments */
00049 /*  ========= */
00050 
00051 /*  RCOND   (input) REAL */
00052 /*          The estimate of the reciprocal condition number obtained by */
00053 /*          forming the explicit inverse of the matrix A and computing */
00054 /*          RCOND = 1/( norm(A) * norm(inv(A)) ). */
00055 
00056 /*  RCONDC  (input) REAL */
00057 /*          The estimate of the reciprocal condition number computed by */
00058 /*          CTPCON. */
00059 
00060 /*  UPLO    (input) CHARACTER */
00061 /*          Specifies whether the matrix A is upper or lower triangular. */
00062 /*          = 'U':  Upper triangular */
00063 /*          = 'L':  Lower triangular */
00064 
00065 /*  DIAG    (input) CHARACTER */
00066 /*          Specifies whether or not the matrix A is unit triangular. */
00067 /*          = 'N':  Non-unit triangular */
00068 /*          = 'U':  Unit triangular */
00069 
00070 /*  N       (input) INTEGER */
00071 /*          The order of the matrix A.  N >= 0. */
00072 
00073 /*  AP      (input) COMPLEX array, dimension (N*(N+1)/2) */
00074 /*          The upper or lower triangular matrix A, packed columnwise in */
00075 /*          a linear array.  The j-th column of A is stored in the array */
00076 /*          AP as follows: */
00077 /*          if UPLO = 'U', AP((j-1)*j/2 + i) = A(i,j) for 1<=i<=j; */
00078 /*          if UPLO = 'L', */
00079 /*             AP((j-1)*(n-j) + j*(j+1)/2 + i-j) = A(i,j) for j<=i<=n. */
00080 
00081 /*  RWORK   (workspace) REAL array, dimension (N) */
00082 
00083 /*  RAT     (output) REAL */
00084 /*          The test ratio.  If both RCOND and RCONDC are nonzero, */
00085 /*             RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1. */
00086 /*          If RAT = 0, the two estimates are exactly the same. */
00087 
00088 /*  ===================================================================== */
00089 
00090 /*     .. Parameters .. */
00091 /*     .. */
00092 /*     .. Local Scalars .. */
00093 /*     .. */
00094 /*     .. External Functions .. */
00095 /*     .. */
00096 /*     .. Intrinsic Functions .. */
00097 /*     .. */
00098 /*     .. Executable Statements .. */
00099 
00100     /* Parameter adjustments */
00101     --rwork;
00102     --ap;
00103 
00104     /* Function Body */
00105     eps = slamch_("Epsilon");
00106     rmax = dmax(*rcond,*rcondc);
00107     rmin = dmin(*rcond,*rcondc);
00108 
00109 /*     Do the easy cases first. */
00110 
00111     if (rmin < 0.f) {
00112 
00113 /*        Invalid value for RCOND or RCONDC, return 1/EPS. */
00114 
00115         *rat = 1.f / eps;
00116 
00117     } else if (rmin > 0.f) {
00118 
00119 /*        Both estimates are positive, return RMAX/RMIN - 1. */
00120 
00121         *rat = rmax / rmin - 1.f;
00122 
00123     } else if (rmax == 0.f) {
00124 
00125 /*        Both estimates zero. */
00126 
00127         *rat = 0.f;
00128 
00129     } else {
00130 
00131 /*        One estimate is zero, the other is non-zero.  If the matrix is */
00132 /*        ill-conditioned, return the nonzero estimate multiplied by */
00133 /*        1/EPS; if the matrix is badly scaled, return the nonzero */
00134 /*        estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum */
00135 /*        element in absolute value in A. */
00136 
00137         bignum = 1.f / slamch_("Safe minimum");
00138         anorm = clantp_("M", uplo, diag, n, &ap[1], &rwork[1]);
00139 
00140 /* Computing MIN */
00141         r__1 = bignum / dmax(1.f,anorm), r__2 = 1.f / eps;
00142         *rat = rmax * dmin(r__1,r__2);
00143     }
00144 
00145     return 0;
00146 
00147 /*     End of CTPT06 */
00148 
00149 } /* ctpt06_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:34