00001 /* zla_rpvgrw.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 doublereal zla_rpvgrw__(integer *n, integer *ncols, doublecomplex *a, integer 00017 *lda, doublecomplex *af, integer *ldaf) 00018 { 00019 /* System generated locals */ 00020 integer a_dim1, a_offset, af_dim1, af_offset, i__1, i__2, i__3; 00021 doublereal ret_val, d__1, d__2, d__3; 00022 00023 /* Builtin functions */ 00024 double d_imag(doublecomplex *); 00025 00026 /* Local variables */ 00027 integer i__, j; 00028 doublereal amax, umax, rpvgrw; 00029 00030 00031 /* -- LAPACK routine (version 3.2.1) -- */ 00032 /* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and -- */ 00033 /* -- Jason Riedy of Univ. of California Berkeley. -- */ 00034 /* -- April 2009 -- */ 00035 00036 /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ 00037 /* -- Univ. of California Berkeley and NAG Ltd. -- */ 00038 00039 /* .. */ 00040 /* .. Scalar Arguments .. */ 00041 /* .. */ 00042 /* .. Array Arguments .. */ 00043 /* .. */ 00044 00045 /* Purpose */ 00046 /* ======= */ 00047 00048 /* ZLA_RPVGRW computes the reciprocal pivot growth factor */ 00049 /* norm(A)/norm(U). The "max absolute element" norm is used. If this is */ 00050 /* much less than 1, the stability of the LU factorization of the */ 00051 /* (equilibrated) matrix A could be poor. This also means that the */ 00052 /* solution X, estimated condition numbers, and error bounds could be */ 00053 /* unreliable. */ 00054 00055 /* Arguments */ 00056 /* ========= */ 00057 00058 /* N (input) INTEGER */ 00059 /* The number of linear equations, i.e., the order of the */ 00060 /* matrix A. N >= 0. */ 00061 00062 /* NCOLS (input) INTEGER */ 00063 /* The number of columns of the matrix A. NCOLS >= 0. */ 00064 00065 /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */ 00066 /* On entry, the N-by-N matrix A. */ 00067 00068 /* LDA (input) INTEGER */ 00069 /* The leading dimension of the array A. LDA >= max(1,N). */ 00070 00071 /* AF (input) DOUBLE PRECISION array, dimension (LDAF,N) */ 00072 /* The factors L and U from the factorization */ 00073 /* A = P*L*U as computed by ZGETRF. */ 00074 00075 /* LDAF (input) INTEGER */ 00076 /* The leading dimension of the array AF. LDAF >= max(1,N). */ 00077 00078 /* ===================================================================== */ 00079 00080 /* .. Local Scalars .. */ 00081 /* .. */ 00082 /* .. Intrinsic Functions .. */ 00083 /* .. */ 00084 /* .. Statement Functions .. */ 00085 /* .. */ 00086 /* .. Statement Function Definitions .. */ 00087 /* .. */ 00088 /* .. Executable Statements .. */ 00089 00090 /* Parameter adjustments */ 00091 a_dim1 = *lda; 00092 a_offset = 1 + a_dim1; 00093 a -= a_offset; 00094 af_dim1 = *ldaf; 00095 af_offset = 1 + af_dim1; 00096 af -= af_offset; 00097 00098 /* Function Body */ 00099 rpvgrw = 1.; 00100 i__1 = *ncols; 00101 for (j = 1; j <= i__1; ++j) { 00102 amax = 0.; 00103 umax = 0.; 00104 i__2 = *n; 00105 for (i__ = 1; i__ <= i__2; ++i__) { 00106 /* Computing MAX */ 00107 i__3 = i__ + j * a_dim1; 00108 d__3 = (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[i__ + j * 00109 a_dim1]), abs(d__2)); 00110 amax = max(d__3,amax); 00111 } 00112 i__2 = j; 00113 for (i__ = 1; i__ <= i__2; ++i__) { 00114 /* Computing MAX */ 00115 i__3 = i__ + j * af_dim1; 00116 d__3 = (d__1 = af[i__3].r, abs(d__1)) + (d__2 = d_imag(&af[i__ + 00117 j * af_dim1]), abs(d__2)); 00118 umax = max(d__3,umax); 00119 } 00120 if (umax != 0.) { 00121 /* Computing MIN */ 00122 d__1 = amax / umax; 00123 rpvgrw = min(d__1,rpvgrw); 00124 } 00125 } 00126 ret_val = rpvgrw; 00127 return ret_val; 00128 } /* zla_rpvgrw__ */