00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static integer c__2 = 2;
00019
00020 int dlatb4_(char *path, integer *imat, integer *m, integer *
00021 n, char *type__, integer *kl, integer *ku, doublereal *anorm, integer
00022 *mode, doublereal *cndnum, char *dist)
00023 {
00024
00025
00026 static logical first = TRUE_;
00027
00028
00029 integer i__1;
00030
00031
00032 double sqrt(doublereal);
00033 int s_copy(char *, char *, ftnlen, ftnlen);
00034
00035
00036 char c2[2];
00037 integer mat;
00038 static doublereal eps, badc1, badc2, large, small;
00039 extern int dlabad_(doublereal *, doublereal *);
00040 extern doublereal dlamch_(char *);
00041 extern logical lsamen_(integer *, char *, char *);
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
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120 if (first) {
00121 first = FALSE_;
00122 eps = dlamch_("Precision");
00123 badc2 = .1 / eps;
00124 badc1 = sqrt(badc2);
00125 small = dlamch_("Safe minimum");
00126 large = 1. / small;
00127
00128
00129
00130
00131 dlabad_(&small, &large);
00132 small = small / eps * .25;
00133 large = 1. / small;
00134 }
00135
00136 s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00137
00138
00139
00140 *(unsigned char *)dist = 'S';
00141 *mode = 3;
00142
00143 if (lsamen_(&c__2, c2, "QR") || lsamen_(&c__2, c2,
00144 "LQ") || lsamen_(&c__2, c2, "QL") || lsamen_(&c__2, c2, "RQ")) {
00145
00146
00147
00148
00149
00150
00151 *(unsigned char *)type__ = 'N';
00152
00153
00154
00155 if (*imat == 1) {
00156 *kl = 0;
00157 *ku = 0;
00158 } else if (*imat == 2) {
00159 *kl = 0;
00160
00161 i__1 = *n - 1;
00162 *ku = max(i__1,0);
00163 } else if (*imat == 3) {
00164
00165 i__1 = *m - 1;
00166 *kl = max(i__1,0);
00167 *ku = 0;
00168 } else {
00169
00170 i__1 = *m - 1;
00171 *kl = max(i__1,0);
00172
00173 i__1 = *n - 1;
00174 *ku = max(i__1,0);
00175 }
00176
00177
00178
00179 if (*imat == 5) {
00180 *cndnum = badc1;
00181 } else if (*imat == 6) {
00182 *cndnum = badc2;
00183 } else {
00184 *cndnum = 2.;
00185 }
00186
00187 if (*imat == 7) {
00188 *anorm = small;
00189 } else if (*imat == 8) {
00190 *anorm = large;
00191 } else {
00192 *anorm = 1.;
00193 }
00194
00195 } else if (lsamen_(&c__2, c2, "GE")) {
00196
00197
00198
00199
00200
00201 *(unsigned char *)type__ = 'N';
00202
00203
00204
00205 if (*imat == 1) {
00206 *kl = 0;
00207 *ku = 0;
00208 } else if (*imat == 2) {
00209 *kl = 0;
00210
00211 i__1 = *n - 1;
00212 *ku = max(i__1,0);
00213 } else if (*imat == 3) {
00214
00215 i__1 = *m - 1;
00216 *kl = max(i__1,0);
00217 *ku = 0;
00218 } else {
00219
00220 i__1 = *m - 1;
00221 *kl = max(i__1,0);
00222
00223 i__1 = *n - 1;
00224 *ku = max(i__1,0);
00225 }
00226
00227
00228
00229 if (*imat == 8) {
00230 *cndnum = badc1;
00231 } else if (*imat == 9) {
00232 *cndnum = badc2;
00233 } else {
00234 *cndnum = 2.;
00235 }
00236
00237 if (*imat == 10) {
00238 *anorm = small;
00239 } else if (*imat == 11) {
00240 *anorm = large;
00241 } else {
00242 *anorm = 1.;
00243 }
00244
00245 } else if (lsamen_(&c__2, c2, "GB")) {
00246
00247
00248
00249
00250
00251 *(unsigned char *)type__ = 'N';
00252
00253
00254
00255 if (*imat == 5) {
00256 *cndnum = badc1;
00257 } else if (*imat == 6) {
00258 *cndnum = badc2 * .1;
00259 } else {
00260 *cndnum = 2.;
00261 }
00262
00263 if (*imat == 7) {
00264 *anorm = small;
00265 } else if (*imat == 8) {
00266 *anorm = large;
00267 } else {
00268 *anorm = 1.;
00269 }
00270
00271 } else if (lsamen_(&c__2, c2, "GT")) {
00272
00273
00274
00275
00276
00277 *(unsigned char *)type__ = 'N';
00278
00279
00280
00281 if (*imat == 1) {
00282 *kl = 0;
00283 } else {
00284 *kl = 1;
00285 }
00286 *ku = *kl;
00287
00288
00289
00290 if (*imat == 3) {
00291 *cndnum = badc1;
00292 } else if (*imat == 4) {
00293 *cndnum = badc2;
00294 } else {
00295 *cndnum = 2.;
00296 }
00297
00298 if (*imat == 5 || *imat == 11) {
00299 *anorm = small;
00300 } else if (*imat == 6 || *imat == 12) {
00301 *anorm = large;
00302 } else {
00303 *anorm = 1.;
00304 }
00305
00306 } else if (lsamen_(&c__2, c2, "PO") || lsamen_(&
00307 c__2, c2, "PP") || lsamen_(&c__2, c2, "SY") || lsamen_(&c__2, c2, "SP")) {
00308
00309
00310
00311
00312
00313
00314 *(unsigned char *)type__ = *(unsigned char *)c2;
00315
00316
00317
00318 if (*imat == 1) {
00319 *kl = 0;
00320 } else {
00321
00322 i__1 = *n - 1;
00323 *kl = max(i__1,0);
00324 }
00325 *ku = *kl;
00326
00327
00328
00329 if (*imat == 6) {
00330 *cndnum = badc1;
00331 } else if (*imat == 7) {
00332 *cndnum = badc2;
00333 } else {
00334 *cndnum = 2.;
00335 }
00336
00337 if (*imat == 8) {
00338 *anorm = small;
00339 } else if (*imat == 9) {
00340 *anorm = large;
00341 } else {
00342 *anorm = 1.;
00343 }
00344
00345 } else if (lsamen_(&c__2, c2, "PB")) {
00346
00347
00348
00349
00350
00351 *(unsigned char *)type__ = 'P';
00352
00353
00354
00355 if (*imat == 5) {
00356 *cndnum = badc1;
00357 } else if (*imat == 6) {
00358 *cndnum = badc2;
00359 } else {
00360 *cndnum = 2.;
00361 }
00362
00363 if (*imat == 7) {
00364 *anorm = small;
00365 } else if (*imat == 8) {
00366 *anorm = large;
00367 } else {
00368 *anorm = 1.;
00369 }
00370
00371 } else if (lsamen_(&c__2, c2, "PT")) {
00372
00373
00374
00375
00376 *(unsigned char *)type__ = 'P';
00377 if (*imat == 1) {
00378 *kl = 0;
00379 } else {
00380 *kl = 1;
00381 }
00382 *ku = *kl;
00383
00384
00385
00386 if (*imat == 3) {
00387 *cndnum = badc1;
00388 } else if (*imat == 4) {
00389 *cndnum = badc2;
00390 } else {
00391 *cndnum = 2.;
00392 }
00393
00394 if (*imat == 5 || *imat == 11) {
00395 *anorm = small;
00396 } else if (*imat == 6 || *imat == 12) {
00397 *anorm = large;
00398 } else {
00399 *anorm = 1.;
00400 }
00401
00402 } else if (lsamen_(&c__2, c2, "TR") || lsamen_(&
00403 c__2, c2, "TP")) {
00404
00405
00406
00407
00408
00409 *(unsigned char *)type__ = 'N';
00410
00411
00412
00413 mat = abs(*imat);
00414 if (mat == 1 || mat == 7) {
00415 *kl = 0;
00416 *ku = 0;
00417 } else if (*imat < 0) {
00418
00419 i__1 = *n - 1;
00420 *kl = max(i__1,0);
00421 *ku = 0;
00422 } else {
00423 *kl = 0;
00424
00425 i__1 = *n - 1;
00426 *ku = max(i__1,0);
00427 }
00428
00429
00430
00431 if (mat == 3 || mat == 9) {
00432 *cndnum = badc1;
00433 } else if (mat == 4) {
00434 *cndnum = badc2;
00435 } else if (mat == 10) {
00436 *cndnum = badc2;
00437 } else {
00438 *cndnum = 2.;
00439 }
00440
00441 if (mat == 5) {
00442 *anorm = small;
00443 } else if (mat == 6) {
00444 *anorm = large;
00445 } else {
00446 *anorm = 1.;
00447 }
00448
00449 } else if (lsamen_(&c__2, c2, "TB")) {
00450
00451
00452
00453
00454
00455 *(unsigned char *)type__ = 'N';
00456
00457
00458
00459 if (*imat == 2 || *imat == 8) {
00460 *cndnum = badc1;
00461 } else if (*imat == 3 || *imat == 9) {
00462 *cndnum = badc2;
00463 } else {
00464 *cndnum = 2.;
00465 }
00466
00467 if (*imat == 4) {
00468 *anorm = small;
00469 } else if (*imat == 5) {
00470 *anorm = large;
00471 } else {
00472 *anorm = 1.;
00473 }
00474 }
00475 if (*n <= 1) {
00476 *cndnum = 1.;
00477 }
00478
00479 return 0;
00480
00481
00482
00483 }