1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
/* sla_rpvgrw.f -- translated by f2c (version 20061008).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#include "f2c.h"
#include "blaswrap.h"
doublereal sla_rpvgrw__(integer *n, integer *ncols, real *a, integer *lda,
real *af, integer *ldaf)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, i__1, i__2;
real ret_val, r__1, r__2;
/* Local variables */
integer i__, j;
real amax, umax, rpvgrw;
/* -- LAPACK routine (version 3.2.1) -- */
/* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and -- */
/* -- Jason Riedy of Univ. of California Berkeley. -- */
/* -- April 2009 -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley and NAG Ltd. -- */
/* .. */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SLA_RPVGRW computes the reciprocal pivot growth factor */
/* norm(A)/norm(U). The "max absolute element" norm is used. If this is */
/* much less than 1, the stability of the LU factorization of the */
/* (equilibrated) matrix A could be poor. This also means that the */
/* solution X, estimated condition numbers, and error bounds could be */
/* unreliable. */
/* Arguments */
/* ========= */
/* N (input) INTEGER */
/* The number of linear equations, i.e., the order of the */
/* matrix A. N >= 0. */
/* NCOLS (input) INTEGER */
/* The number of columns of the matrix A. NCOLS >= 0. */
/* A (input) REAL array, dimension (LDA,N) */
/* On entry, the N-by-N matrix A. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* AF (input) REAL array, dimension (LDAF,N) */
/* The factors L and U from the factorization */
/* A = P*L*U as computed by SGETRF. */
/* LDAF (input) INTEGER */
/* The leading dimension of the array AF. LDAF >= max(1,N). */
/* ===================================================================== */
/* .. Local Scalars .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
af_dim1 = *ldaf;
af_offset = 1 + af_dim1;
af -= af_offset;
/* Function Body */
rpvgrw = 1.f;
i__1 = *ncols;
for (j = 1; j <= i__1; ++j) {
amax = 0.f;
umax = 0.f;
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
r__2 = (r__1 = a[i__ + j * a_dim1], dabs(r__1));
amax = dmax(r__2,amax);
}
i__2 = j;
for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
r__2 = (r__1 = af[i__ + j * af_dim1], dabs(r__1));
umax = dmax(r__2,umax);
}
if (umax != 0.f) {
/* Computing MIN */
r__1 = amax / umax;
rpvgrw = dmin(r__1,rpvgrw);
}
}
ret_val = rpvgrw;
return ret_val;
} /* sla_rpvgrw__ */
|
