Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
eis_balanc.c
Go to the documentation of this file.00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008 int balanc_(integer *nm, integer *n, doublereal *a, integer *
00009 low, integer *igh, doublereal *scale)
00010 {
00011
00012 integer a_dim1, a_offset, i__1, i__2;
00013 doublereal d__1;
00014
00015
00016 static integer iexc;
00017 static doublereal c__, f, g;
00018 static integer i__, j, k, l, m;
00019 static doublereal r__, s, radix, b2;
00020 static integer jj;
00021 static logical noconv;
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080 --scale;
00081 a_dim1 = *nm;
00082 a_offset = a_dim1 + 1;
00083 a -= a_offset;
00084
00085
00086 radix = 16.;
00087
00088 b2 = radix * radix;
00089 k = 1;
00090 l = *n;
00091 goto L100;
00092
00093
00094 L20:
00095 scale[m] = (doublereal) j;
00096 if (j == m) {
00097 goto L50;
00098 }
00099
00100 i__1 = l;
00101 for (i__ = 1; i__ <= i__1; ++i__) {
00102 f = a[i__ + j * a_dim1];
00103 a[i__ + j * a_dim1] = a[i__ + m * a_dim1];
00104 a[i__ + m * a_dim1] = f;
00105
00106 }
00107
00108 i__1 = *n;
00109 for (i__ = k; i__ <= i__1; ++i__) {
00110 f = a[j + i__ * a_dim1];
00111 a[j + i__ * a_dim1] = a[m + i__ * a_dim1];
00112 a[m + i__ * a_dim1] = f;
00113
00114 }
00115
00116 L50:
00117 switch (iexc) {
00118 case 1: goto L80;
00119 case 2: goto L130;
00120 }
00121
00122
00123 L80:
00124 if (l == 1) {
00125 goto L280;
00126 }
00127 --l;
00128
00129 L100:
00130 i__1 = l;
00131 for (jj = 1; jj <= i__1; ++jj) {
00132 j = l + 1 - jj;
00133
00134 i__2 = l;
00135 for (i__ = 1; i__ <= i__2; ++i__) {
00136 if (i__ == j) {
00137 goto L110;
00138 }
00139 if (a[j + i__ * a_dim1] != 0.) {
00140 goto L120;
00141 }
00142 L110:
00143 ;
00144 }
00145
00146 m = l;
00147 iexc = 1;
00148 goto L20;
00149 L120:
00150 ;
00151 }
00152
00153 goto L140;
00154
00155
00156 L130:
00157 ++k;
00158
00159 L140:
00160 i__1 = l;
00161 for (j = k; j <= i__1; ++j) {
00162
00163 i__2 = l;
00164 for (i__ = k; i__ <= i__2; ++i__) {
00165 if (i__ == j) {
00166 goto L150;
00167 }
00168 if (a[i__ + j * a_dim1] != 0.) {
00169 goto L170;
00170 }
00171 L150:
00172 ;
00173 }
00174
00175 m = k;
00176 iexc = 2;
00177 goto L20;
00178 L170:
00179 ;
00180 }
00181
00182 i__1 = l;
00183 for (i__ = k; i__ <= i__1; ++i__) {
00184
00185 scale[i__] = 1.;
00186 }
00187
00188 L190:
00189 noconv = FALSE_;
00190
00191 i__1 = l;
00192 for (i__ = k; i__ <= i__1; ++i__) {
00193 c__ = 0.;
00194 r__ = 0.;
00195
00196 i__2 = l;
00197 for (j = k; j <= i__2; ++j) {
00198 if (j == i__) {
00199 goto L200;
00200 }
00201 c__ += (d__1 = a[j + i__ * a_dim1], abs(d__1));
00202 r__ += (d__1 = a[i__ + j * a_dim1], abs(d__1));
00203 L200:
00204 ;
00205 }
00206
00207
00208 if (c__ == 0. || r__ == 0.) {
00209 goto L270;
00210 }
00211 g = r__ / radix;
00212 f = 1.;
00213 s = c__ + r__;
00214 L210:
00215 if (c__ >= g) {
00216 goto L220;
00217 }
00218 f *= radix;
00219 c__ *= b2;
00220 goto L210;
00221 L220:
00222 g = r__ * radix;
00223 L230:
00224 if (c__ < g) {
00225 goto L240;
00226 }
00227 f /= radix;
00228 c__ /= b2;
00229 goto L230;
00230
00231 L240:
00232 if ((c__ + r__) / f >= s * .95) {
00233 goto L270;
00234 }
00235 g = 1. / f;
00236 scale[i__] *= f;
00237 noconv = TRUE_;
00238
00239 i__2 = *n;
00240 for (j = k; j <= i__2; ++j) {
00241
00242 a[i__ + j * a_dim1] *= g;
00243 }
00244
00245 i__2 = l;
00246 for (j = 1; j <= i__2; ++j) {
00247
00248 a[j + i__ * a_dim1] *= f;
00249 }
00250
00251 L270:
00252 ;
00253 }
00254
00255 if (noconv) {
00256 goto L190;
00257 }
00258
00259 L280:
00260 *low = k;
00261 *igh = l;
00262 return 0;
00263 }
00264