00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 #include "string.h"
00016
00017
00018
00019 static integer c__1 = 1;
00020 static real c_b163 = 0.f;
00021 static real c_b164 = 1.f;
00022 static integer c__0 = 0;
00023
00024 integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
00025 integer *n2, integer *n3, integer *n4)
00026 {
00027
00028 integer ret_val;
00029
00030
00031 int s_copy(char *, char *, ftnlen, ftnlen);
00032 integer s_cmp(char *, char *, ftnlen, ftnlen);
00033
00034
00035 integer i__;
00036 char c1[1], c2[2], c3[3], c4[2];
00037 integer ic, nb, iz, nx;
00038 logical cname;
00039 integer nbmin;
00040 logical sname;
00041 extern integer ieeeck_(integer *, real *, real *);
00042 char subnam[6];
00043 extern integer iparmq_(integer *, char *, char *, integer *, integer *,
00044 integer *, integer *);
00045
00046 ftnlen name_len, opts_len;
00047
00048 name_len = strlen (name__);
00049 opts_len = strlen (opts);
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
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159 switch (*ispec) {
00160 case 1: goto L10;
00161 case 2: goto L10;
00162 case 3: goto L10;
00163 case 4: goto L80;
00164 case 5: goto L90;
00165 case 6: goto L100;
00166 case 7: goto L110;
00167 case 8: goto L120;
00168 case 9: goto L130;
00169 case 10: goto L140;
00170 case 11: goto L150;
00171 case 12: goto L160;
00172 case 13: goto L160;
00173 case 14: goto L160;
00174 case 15: goto L160;
00175 case 16: goto L160;
00176 }
00177
00178
00179
00180 ret_val = -1;
00181 return ret_val;
00182
00183 L10:
00184
00185
00186
00187 ret_val = 1;
00188 s_copy(subnam, name__, (ftnlen)1, name_len);
00189 ic = *(unsigned char *)subnam;
00190 iz = 'Z';
00191 if (iz == 90 || iz == 122) {
00192
00193
00194
00195 if (ic >= 97 && ic <= 122) {
00196 *(unsigned char *)subnam = (char) (ic - 32);
00197 for (i__ = 2; i__ <= 6; ++i__) {
00198 ic = *(unsigned char *)&subnam[i__ - 1];
00199 if (ic >= 97 && ic <= 122) {
00200 *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
00201 }
00202
00203 }
00204 }
00205
00206 } else if (iz == 233 || iz == 169) {
00207
00208
00209
00210 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
00211 ic <= 169) {
00212 *(unsigned char *)subnam = (char) (ic + 64);
00213 for (i__ = 2; i__ <= 6; ++i__) {
00214 ic = *(unsigned char *)&subnam[i__ - 1];
00215 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
00216 162 && ic <= 169) {
00217 *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
00218 }
00219
00220 }
00221 }
00222
00223 } else if (iz == 218 || iz == 250) {
00224
00225
00226
00227 if (ic >= 225 && ic <= 250) {
00228 *(unsigned char *)subnam = (char) (ic - 32);
00229 for (i__ = 2; i__ <= 6; ++i__) {
00230 ic = *(unsigned char *)&subnam[i__ - 1];
00231 if (ic >= 225 && ic <= 250) {
00232 *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
00233 }
00234
00235 }
00236 }
00237 }
00238
00239 *(unsigned char *)c1 = *(unsigned char *)subnam;
00240 sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
00241 cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
00242 if (! (cname || sname)) {
00243 return ret_val;
00244 }
00245 s_copy(c2, subnam + 1, (ftnlen)1, (ftnlen)2);
00246 s_copy(c3, subnam + 3, (ftnlen)1, (ftnlen)3);
00247 s_copy(c4, c3 + 1, (ftnlen)1, (ftnlen)2);
00248
00249 switch (*ispec) {
00250 case 1: goto L50;
00251 case 2: goto L60;
00252 case 3: goto L70;
00253 }
00254
00255 L50:
00256
00257
00258
00259
00260
00261
00262
00263 nb = 1;
00264
00265 if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
00266 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00267 if (sname) {
00268 nb = 64;
00269 } else {
00270 nb = 64;
00271 }
00272 } else if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3,
00273 "RQF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
00274 1, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3)
00275 == 0) {
00276 if (sname) {
00277 nb = 32;
00278 } else {
00279 nb = 32;
00280 }
00281 } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
00282 if (sname) {
00283 nb = 32;
00284 } else {
00285 nb = 32;
00286 }
00287 } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
00288 if (sname) {
00289 nb = 32;
00290 } else {
00291 nb = 32;
00292 }
00293 } else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
00294 if (sname) {
00295 nb = 64;
00296 } else {
00297 nb = 64;
00298 }
00299 }
00300 } else if (s_cmp(c2, "PO", (ftnlen)1, (ftnlen)2) == 0) {
00301 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00302 if (sname) {
00303 nb = 64;
00304 } else {
00305 nb = 64;
00306 }
00307 }
00308 } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
00309 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00310 if (sname) {
00311 nb = 64;
00312 } else {
00313 nb = 64;
00314 }
00315 } else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00316 nb = 32;
00317 } else if (sname && s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
00318 nb = 64;
00319 }
00320 } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
00321 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00322 nb = 64;
00323 } else if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00324 nb = 32;
00325 } else if (s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
00326 nb = 64;
00327 }
00328 } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
00329 if (*(unsigned char *)c3 == 'G') {
00330 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00331 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00332 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00333 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00334 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00335 ftnlen)1, (ftnlen)2) == 0) {
00336 nb = 32;
00337 }
00338 } else if (*(unsigned char *)c3 == 'M') {
00339 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00340 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00341 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00342 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00343 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00344 ftnlen)1, (ftnlen)2) == 0) {
00345 nb = 32;
00346 }
00347 }
00348 } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
00349 if (*(unsigned char *)c3 == 'G') {
00350 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00351 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00352 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00353 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00354 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00355 ftnlen)1, (ftnlen)2) == 0) {
00356 nb = 32;
00357 }
00358 } else if (*(unsigned char *)c3 == 'M') {
00359 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00360 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00361 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00362 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00363 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00364 ftnlen)1, (ftnlen)2) == 0) {
00365 nb = 32;
00366 }
00367 }
00368 } else if (s_cmp(c2, "GB", (ftnlen)1, (ftnlen)2) == 0) {
00369 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00370 if (sname) {
00371 if (*n4 <= 64) {
00372 nb = 1;
00373 } else {
00374 nb = 32;
00375 }
00376 } else {
00377 if (*n4 <= 64) {
00378 nb = 1;
00379 } else {
00380 nb = 32;
00381 }
00382 }
00383 }
00384 } else if (s_cmp(c2, "PB", (ftnlen)1, (ftnlen)2) == 0) {
00385 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00386 if (sname) {
00387 if (*n2 <= 64) {
00388 nb = 1;
00389 } else {
00390 nb = 32;
00391 }
00392 } else {
00393 if (*n2 <= 64) {
00394 nb = 1;
00395 } else {
00396 nb = 32;
00397 }
00398 }
00399 }
00400 } else if (s_cmp(c2, "TR", (ftnlen)1, (ftnlen)2) == 0) {
00401 if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
00402 if (sname) {
00403 nb = 64;
00404 } else {
00405 nb = 64;
00406 }
00407 }
00408 } else if (s_cmp(c2, "LA", (ftnlen)1, (ftnlen)2) == 0) {
00409 if (s_cmp(c3, "UUM", (ftnlen)1, (ftnlen)3) == 0) {
00410 if (sname) {
00411 nb = 64;
00412 } else {
00413 nb = 64;
00414 }
00415 }
00416 } else if (sname && s_cmp(c2, "ST", (ftnlen)1, (ftnlen)2) == 0) {
00417 if (s_cmp(c3, "EBZ", (ftnlen)1, (ftnlen)3) == 0) {
00418 nb = 1;
00419 }
00420 }
00421 ret_val = nb;
00422 return ret_val;
00423
00424 L60:
00425
00426
00427
00428 nbmin = 2;
00429 if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
00430 if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
00431 ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
00432 ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
00433 {
00434 if (sname) {
00435 nbmin = 2;
00436 } else {
00437 nbmin = 2;
00438 }
00439 } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
00440 if (sname) {
00441 nbmin = 2;
00442 } else {
00443 nbmin = 2;
00444 }
00445 } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
00446 if (sname) {
00447 nbmin = 2;
00448 } else {
00449 nbmin = 2;
00450 }
00451 } else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
00452 if (sname) {
00453 nbmin = 2;
00454 } else {
00455 nbmin = 2;
00456 }
00457 }
00458 } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
00459 if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
00460 if (sname) {
00461 nbmin = 8;
00462 } else {
00463 nbmin = 8;
00464 }
00465 } else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00466 nbmin = 2;
00467 }
00468 } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
00469 if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00470 nbmin = 2;
00471 }
00472 } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
00473 if (*(unsigned char *)c3 == 'G') {
00474 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00475 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00476 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00477 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00478 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00479 ftnlen)1, (ftnlen)2) == 0) {
00480 nbmin = 2;
00481 }
00482 } else if (*(unsigned char *)c3 == 'M') {
00483 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00484 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00485 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00486 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00487 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00488 ftnlen)1, (ftnlen)2) == 0) {
00489 nbmin = 2;
00490 }
00491 }
00492 } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
00493 if (*(unsigned char *)c3 == 'G') {
00494 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00495 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00496 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00497 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00498 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00499 ftnlen)1, (ftnlen)2) == 0) {
00500 nbmin = 2;
00501 }
00502 } else if (*(unsigned char *)c3 == 'M') {
00503 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00504 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00505 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00506 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00507 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00508 ftnlen)1, (ftnlen)2) == 0) {
00509 nbmin = 2;
00510 }
00511 }
00512 }
00513 ret_val = nbmin;
00514 return ret_val;
00515
00516 L70:
00517
00518
00519
00520 nx = 0;
00521 if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
00522 if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
00523 ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
00524 ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
00525 {
00526 if (sname) {
00527 nx = 128;
00528 } else {
00529 nx = 128;
00530 }
00531 } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
00532 if (sname) {
00533 nx = 128;
00534 } else {
00535 nx = 128;
00536 }
00537 } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
00538 if (sname) {
00539 nx = 128;
00540 } else {
00541 nx = 128;
00542 }
00543 }
00544 } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
00545 if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00546 nx = 32;
00547 }
00548 } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
00549 if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
00550 nx = 32;
00551 }
00552 } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
00553 if (*(unsigned char *)c3 == 'G') {
00554 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00555 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00556 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00557 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00558 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00559 ftnlen)1, (ftnlen)2) == 0) {
00560 nx = 128;
00561 }
00562 }
00563 } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
00564 if (*(unsigned char *)c3 == 'G') {
00565 if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
00566 (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
00567 ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
00568 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
00569 c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
00570 ftnlen)1, (ftnlen)2) == 0) {
00571 nx = 128;
00572 }
00573 }
00574 }
00575 ret_val = nx;
00576 return ret_val;
00577
00578 L80:
00579
00580
00581
00582 ret_val = 6;
00583 return ret_val;
00584
00585 L90:
00586
00587
00588
00589 ret_val = 2;
00590 return ret_val;
00591
00592 L100:
00593
00594
00595
00596 ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
00597 return ret_val;
00598
00599 L110:
00600
00601
00602
00603 ret_val = 1;
00604 return ret_val;
00605
00606 L120:
00607
00608
00609
00610 ret_val = 50;
00611 return ret_val;
00612
00613 L130:
00614
00615
00616
00617
00618
00619 ret_val = 25;
00620 return ret_val;
00621
00622 L140:
00623
00624
00625
00626
00627 ret_val = 1;
00628 if (ret_val == 1) {
00629 ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
00630 }
00631 return ret_val;
00632
00633 L150:
00634
00635
00636
00637
00638 ret_val = 1;
00639 if (ret_val == 1) {
00640 ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
00641 }
00642 return ret_val;
00643
00644 L160:
00645
00646
00647
00648 ret_val = iparmq_(ispec, name__, opts, n1, n2, n3, n4)
00649 ;
00650 return ret_val;
00651
00652
00653
00654 }