zla_gbrpvgrw.c
Go to the documentation of this file.
00001 /* zla_gbrpvgrw.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_gbrpvgrw__(integer *n, integer *kl, integer *ku, integer *
00017         ncols, doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *
00018         ldafb)
00019 {
00020     /* System generated locals */
00021     integer ab_dim1, ab_offset, afb_dim1, afb_offset, i__1, i__2, i__3, i__4;
00022     doublereal ret_val, d__1, d__2, d__3;
00023 
00024     /* Builtin functions */
00025     double d_imag(doublecomplex *);
00026 
00027     /* Local variables */
00028     integer i__, j, kd;
00029     doublereal amax, umax, rpvgrw;
00030 
00031 
00032 /*     -- LAPACK routine (version 3.2.1)                                 -- */
00033 /*     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and -- */
00034 /*     -- Jason Riedy of Univ. of California Berkeley.                 -- */
00035 /*     -- April 2009                                                   -- */
00036 
00037 /*     -- LAPACK is a software package provided by Univ. of Tennessee, -- */
00038 /*     -- Univ. of California Berkeley and NAG Ltd.                    -- */
00039 
00040 /*     .. */
00041 /*     .. Scalar Arguments .. */
00042 /*     .. */
00043 /*     .. Array Arguments .. */
00044 /*     .. */
00045 
00046 /*  Purpose */
00047 /*  ======= */
00048 
00049 /*  ZLA_GBRPVGRW computes the reciprocal pivot growth factor */
00050 /*  norm(A)/norm(U). The "max absolute element" norm is used. If this is */
00051 /*  much less than 1, the stability of the LU factorization of the */
00052 /*  (equilibrated) matrix A could be poor. This also means that the */
00053 /*  solution X, estimated condition numbers, and error bounds could be */
00054 /*  unreliable. */
00055 
00056 /*  Arguments */
00057 /*  ========= */
00058 
00059 /*     N       (input) INTEGER */
00060 /*     The number of linear equations, i.e., the order of the */
00061 /*     matrix A.  N >= 0. */
00062 
00063 /*     KL      (input) INTEGER */
00064 /*     The number of subdiagonals within the band of A.  KL >= 0. */
00065 
00066 /*     KU      (input) INTEGER */
00067 /*     The number of superdiagonals within the band of A.  KU >= 0. */
00068 
00069 /*     NCOLS   (input) INTEGER */
00070 /*     The number of columns of the matrix A.  NCOLS >= 0. */
00071 
00072 /*     AB      (input) COMPLEX*16 array, dimension (LDAB,N) */
00073 /*     On entry, the matrix A in band storage, in rows 1 to KL+KU+1. */
00074 /*     The j-th column of A is stored in the j-th column of the */
00075 /*     array AB as follows: */
00076 /*     AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) */
00077 
00078 /*     LDAB    (input) INTEGER */
00079 /*     The leading dimension of the array AB.  LDAB >= KL+KU+1. */
00080 
00081 /*     AFB     (input) COMPLEX*16 array, dimension (LDAFB,N) */
00082 /*     Details of the LU factorization of the band matrix A, as */
00083 /*     computed by ZGBTRF.  U is stored as an upper triangular */
00084 /*     band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, */
00085 /*     and the multipliers used during the factorization are stored */
00086 /*     in rows KL+KU+2 to 2*KL+KU+1. */
00087 
00088 /*     LDAFB   (input) INTEGER */
00089 /*     The leading dimension of the array AFB.  LDAFB >= 2*KL+KU+1. */
00090 
00091 /*  ===================================================================== */
00092 
00093 /*     .. Local Scalars .. */
00094 /*     .. */
00095 /*     .. Intrinsic Functions .. */
00096 /*     .. */
00097 /*     .. Statement Functions .. */
00098 /*     .. */
00099 /*     .. Statement Function Definitions .. */
00100 /*     .. */
00101 /*     .. Executable Statements .. */
00102 
00103     /* Parameter adjustments */
00104     ab_dim1 = *ldab;
00105     ab_offset = 1 + ab_dim1;
00106     ab -= ab_offset;
00107     afb_dim1 = *ldafb;
00108     afb_offset = 1 + afb_dim1;
00109     afb -= afb_offset;
00110 
00111     /* Function Body */
00112     rpvgrw = 1.;
00113     kd = *ku + 1;
00114     i__1 = *ncols;
00115     for (j = 1; j <= i__1; ++j) {
00116         amax = 0.;
00117         umax = 0.;
00118 /* Computing MAX */
00119         i__2 = j - *ku;
00120 /* Computing MIN */
00121         i__4 = j + *kl;
00122         i__3 = min(i__4,*n);
00123         for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
00124 /* Computing MAX */
00125             i__2 = kd + i__ - j + j * ab_dim1;
00126             d__3 = (d__1 = ab[i__2].r, abs(d__1)) + (d__2 = d_imag(&ab[kd + 
00127                     i__ - j + j * ab_dim1]), abs(d__2));
00128             amax = max(d__3,amax);
00129         }
00130 /* Computing MAX */
00131         i__3 = j - *ku;
00132         i__2 = j;
00133         for (i__ = max(i__3,1); i__ <= i__2; ++i__) {
00134 /* Computing MAX */
00135             i__3 = kd + i__ - j + j * afb_dim1;
00136             d__3 = (d__1 = afb[i__3].r, abs(d__1)) + (d__2 = d_imag(&afb[kd + 
00137                     i__ - j + j * afb_dim1]), abs(d__2));
00138             umax = max(d__3,umax);
00139         }
00140         if (umax != 0.) {
00141 /* Computing MIN */
00142             d__1 = amax / umax;
00143             rpvgrw = min(d__1,rpvgrw);
00144         }
00145     }
00146     ret_val = rpvgrw;
00147     return ret_val;
00148 } /* zla_gbrpvgrw__ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:40