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__5 = 5;
00019 static integer c__2 = 2;
00020 static integer c__1 = 1;
00021 static integer c__4 = 4;
00022 static doublereal c_b91 = 2.;
00023 static integer c_n1 = -1;
00024
00025 int zlattb_(integer *imat, char *uplo, char *trans, char *
00026 diag, integer *iseed, integer *n, integer *kd, doublecomplex *ab,
00027 integer *ldab, doublecomplex *b, doublecomplex *work, doublereal *
00028 rwork, integer *info)
00029 {
00030
00031 integer ab_dim1, ab_offset, i__1, i__2, i__3, i__4, i__5;
00032 doublereal d__1, d__2;
00033 doublecomplex z__1, z__2;
00034
00035
00036 int s_copy(char *, char *, ftnlen, ftnlen);
00037 double sqrt(doublereal);
00038 void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
00039 double pow_dd(doublereal *, doublereal *), z_abs(doublecomplex *);
00040
00041
00042 integer i__, j, kl, ku, iy;
00043 doublereal ulp, sfac;
00044 integer ioff, mode, lenj;
00045 char path[3], dist[1];
00046 doublereal unfl, rexp;
00047 char type__[1];
00048 doublereal texp;
00049 doublecomplex star1, plus1, plus2;
00050 doublereal bscal;
00051 extern logical lsame_(char *, char *);
00052 doublereal tscal, anorm, bnorm, tleft;
00053 logical upper;
00054 doublereal tnorm;
00055 extern int zcopy_(integer *, doublecomplex *, integer *,
00056 doublecomplex *, integer *), zswap_(integer *, doublecomplex *,
00057 integer *, doublecomplex *, integer *), zlatb4_(char *, integer *,
00058 integer *, integer *, char *, integer *, integer *, doublereal *,
00059 integer *, doublereal *, char *),
00060 dlabad_(doublereal *, doublereal *);
00061 extern doublereal dlamch_(char *), dlarnd_(integer *, integer *);
00062 char packit[1];
00063 extern int zdscal_(integer *, doublereal *,
00064 doublecomplex *, integer *);
00065 doublereal bignum, cndnum;
00066 extern int dlarnv_(integer *, integer *, integer *,
00067 doublereal *);
00068 extern integer izamax_(integer *, doublecomplex *, integer *);
00069 extern VOID zlarnd_(doublecomplex *, integer *,
00070 integer *);
00071 integer jcount;
00072 extern int zlatms_(integer *, integer *, char *, integer
00073 *, char *, doublereal *, integer *, doublereal *, doublereal *,
00074 integer *, integer *, char *, doublecomplex *, integer *,
00075 doublecomplex *, integer *);
00076 doublereal smlnum;
00077 extern int zlarnv_(integer *, integer *, integer *,
00078 doublecomplex *);
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
00160
00161
00162
00163
00164
00165
00166 --iseed;
00167 ab_dim1 = *ldab;
00168 ab_offset = 1 + ab_dim1;
00169 ab -= ab_offset;
00170 --b;
00171 --work;
00172 --rwork;
00173
00174
00175 s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
00176 s_copy(path + 1, "TB", (ftnlen)2, (ftnlen)2);
00177 unfl = dlamch_("Safe minimum");
00178 ulp = dlamch_("Epsilon") * dlamch_("Base");
00179 smlnum = unfl;
00180 bignum = (1. - ulp) / smlnum;
00181 dlabad_(&smlnum, &bignum);
00182 if (*imat >= 6 && *imat <= 9 || *imat == 17) {
00183 *(unsigned char *)diag = 'U';
00184 } else {
00185 *(unsigned char *)diag = 'N';
00186 }
00187 *info = 0;
00188
00189
00190
00191 if (*n <= 0) {
00192 return 0;
00193 }
00194
00195
00196
00197 upper = lsame_(uplo, "U");
00198 if (upper) {
00199 zlatb4_(path, imat, n, n, type__, &kl, &ku, &anorm, &mode, &cndnum,
00200 dist);
00201 ku = *kd;
00202
00203 i__1 = 0, i__2 = *kd - *n + 1;
00204 ioff = max(i__1,i__2) + 1;
00205 kl = 0;
00206 *(unsigned char *)packit = 'Q';
00207 } else {
00208 i__1 = -(*imat);
00209 zlatb4_(path, &i__1, n, n, type__, &kl, &ku, &anorm, &mode, &cndnum,
00210 dist);
00211 kl = *kd;
00212 ioff = 1;
00213 ku = 0;
00214 *(unsigned char *)packit = 'B';
00215 }
00216
00217
00218
00219 if (*imat <= 5) {
00220 zlatms_(n, n, dist, &iseed[1], type__, &rwork[1], &mode, &cndnum, &
00221 anorm, &kl, &ku, packit, &ab[ioff + ab_dim1], ldab, &work[1],
00222 info);
00223
00224
00225
00226
00227
00228
00229 } else if (*imat == 6) {
00230 if (upper) {
00231 i__1 = *n;
00232 for (j = 1; j <= i__1; ++j) {
00233
00234 i__2 = 1, i__3 = *kd + 2 - j;
00235 i__4 = *kd;
00236 for (i__ = max(i__2,i__3); i__ <= i__4; ++i__) {
00237 i__2 = i__ + j * ab_dim1;
00238 ab[i__2].r = 0., ab[i__2].i = 0.;
00239
00240 }
00241 i__4 = *kd + 1 + j * ab_dim1;
00242 ab[i__4].r = (doublereal) j, ab[i__4].i = 0.;
00243
00244 }
00245 } else {
00246 i__1 = *n;
00247 for (j = 1; j <= i__1; ++j) {
00248 i__4 = j * ab_dim1 + 1;
00249 ab[i__4].r = (doublereal) j, ab[i__4].i = 0.;
00250
00251 i__2 = *kd + 1, i__3 = *n - j + 1;
00252 i__4 = min(i__2,i__3);
00253 for (i__ = 2; i__ <= i__4; ++i__) {
00254 i__2 = i__ + j * ab_dim1;
00255 ab[i__2].r = 0., ab[i__2].i = 0.;
00256
00257 }
00258
00259 }
00260 }
00261
00262
00263
00264
00265
00266
00267 } else if (*imat <= 9) {
00268 tnorm = sqrt(cndnum);
00269
00270
00271
00272 if (upper) {
00273 i__1 = *n;
00274 for (j = 1; j <= i__1; ++j) {
00275
00276 i__4 = 1, i__2 = *kd + 2 - j;
00277 i__3 = *kd;
00278 for (i__ = max(i__4,i__2); i__ <= i__3; ++i__) {
00279 i__4 = i__ + j * ab_dim1;
00280 ab[i__4].r = 0., ab[i__4].i = 0.;
00281
00282 }
00283 i__3 = *kd + 1 + j * ab_dim1;
00284 d__1 = (doublereal) j;
00285 ab[i__3].r = d__1, ab[i__3].i = 0.;
00286
00287 }
00288 } else {
00289 i__1 = *n;
00290 for (j = 1; j <= i__1; ++j) {
00291
00292 i__4 = *kd + 1, i__2 = *n - j + 1;
00293 i__3 = min(i__4,i__2);
00294 for (i__ = 2; i__ <= i__3; ++i__) {
00295 i__4 = i__ + j * ab_dim1;
00296 ab[i__4].r = 0., ab[i__4].i = 0.;
00297
00298 }
00299 i__3 = j * ab_dim1 + 1;
00300 d__1 = (doublereal) j;
00301 ab[i__3].r = d__1, ab[i__3].i = 0.;
00302
00303 }
00304 }
00305
00306
00307
00308
00309 if (*kd == 1) {
00310 if (upper) {
00311 i__1 = (ab_dim1 << 1) + 1;
00312 zlarnd_(&z__2, &c__5, &iseed[1]);
00313 z__1.r = tnorm * z__2.r, z__1.i = tnorm * z__2.i;
00314 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00315 lenj = (*n - 3) / 2;
00316 zlarnv_(&c__2, &iseed[1], &lenj, &work[1]);
00317 i__1 = lenj;
00318 for (j = 1; j <= i__1; ++j) {
00319 i__3 = (j + 1 << 1) * ab_dim1 + 1;
00320 i__4 = j;
00321 z__1.r = tnorm * work[i__4].r, z__1.i = tnorm * work[i__4]
00322 .i;
00323 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00324
00325 }
00326 } else {
00327 i__1 = ab_dim1 + 2;
00328 zlarnd_(&z__2, &c__5, &iseed[1]);
00329 z__1.r = tnorm * z__2.r, z__1.i = tnorm * z__2.i;
00330 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00331 lenj = (*n - 3) / 2;
00332 zlarnv_(&c__2, &iseed[1], &lenj, &work[1]);
00333 i__1 = lenj;
00334 for (j = 1; j <= i__1; ++j) {
00335 i__3 = ((j << 1) + 1) * ab_dim1 + 2;
00336 i__4 = j;
00337 z__1.r = tnorm * work[i__4].r, z__1.i = tnorm * work[i__4]
00338 .i;
00339 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00340
00341 }
00342 }
00343 } else if (*kd > 1) {
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361 zlarnd_(&z__2, &c__5, &iseed[1]);
00362 z__1.r = tnorm * z__2.r, z__1.i = tnorm * z__2.i;
00363 star1.r = z__1.r, star1.i = z__1.i;
00364 sfac = sqrt(tnorm);
00365 zlarnd_(&z__2, &c__5, &iseed[1]);
00366 z__1.r = sfac * z__2.r, z__1.i = sfac * z__2.i;
00367 plus1.r = z__1.r, plus1.i = z__1.i;
00368 i__1 = *n;
00369 for (j = 1; j <= i__1; j += 2) {
00370 z_div(&z__1, &star1, &plus1);
00371 plus2.r = z__1.r, plus2.i = z__1.i;
00372 i__3 = j;
00373 work[i__3].r = plus1.r, work[i__3].i = plus1.i;
00374 i__3 = *n + j;
00375 work[i__3].r = star1.r, work[i__3].i = star1.i;
00376 if (j + 1 <= *n) {
00377 i__3 = j + 1;
00378 work[i__3].r = plus2.r, work[i__3].i = plus2.i;
00379 i__3 = *n + j + 1;
00380 work[i__3].r = 0., work[i__3].i = 0.;
00381 z_div(&z__1, &star1, &plus2);
00382 plus1.r = z__1.r, plus1.i = z__1.i;
00383
00384
00385
00386
00387 rexp = dlarnd_(&c__2, &iseed[1]);
00388 if (rexp < 0.) {
00389 d__2 = 1. - rexp;
00390 d__1 = -pow_dd(&sfac, &d__2);
00391 zlarnd_(&z__2, &c__5, &iseed[1]);
00392 z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00393 star1.r = z__1.r, star1.i = z__1.i;
00394 } else {
00395 d__2 = rexp + 1.;
00396 d__1 = pow_dd(&sfac, &d__2);
00397 zlarnd_(&z__2, &c__5, &iseed[1]);
00398 z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00399 star1.r = z__1.r, star1.i = z__1.i;
00400 }
00401 }
00402
00403 }
00404
00405
00406
00407 if (upper) {
00408 i__1 = *n - 1;
00409 zcopy_(&i__1, &work[1], &c__1, &ab[*kd + (ab_dim1 << 1)],
00410 ldab);
00411 i__1 = *n - 2;
00412 zcopy_(&i__1, &work[*n + 1], &c__1, &ab[*kd - 1 + ab_dim1 * 3]
00413 , ldab);
00414 } else {
00415 i__1 = *n - 1;
00416 zcopy_(&i__1, &work[1], &c__1, &ab[ab_dim1 + 2], ldab);
00417 i__1 = *n - 2;
00418 zcopy_(&i__1, &work[*n + 1], &c__1, &ab[ab_dim1 + 3], ldab);
00419 }
00420 }
00421
00422
00423
00424
00425
00426 } else if (*imat == 10) {
00427
00428
00429
00430
00431
00432 if (upper) {
00433 i__1 = *n;
00434 for (j = 1; j <= i__1; ++j) {
00435
00436 i__3 = j - 1;
00437 lenj = min(i__3,*kd);
00438 zlarnv_(&c__4, &iseed[1], &lenj, &ab[*kd + 1 - lenj + j *
00439 ab_dim1]);
00440 i__3 = *kd + 1 + j * ab_dim1;
00441 zlarnd_(&z__2, &c__5, &iseed[1]);
00442 z__1.r = z__2.r * 2., z__1.i = z__2.i * 2.;
00443 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00444
00445 }
00446 } else {
00447 i__1 = *n;
00448 for (j = 1; j <= i__1; ++j) {
00449
00450 i__3 = *n - j;
00451 lenj = min(i__3,*kd);
00452 if (lenj > 0) {
00453 zlarnv_(&c__4, &iseed[1], &lenj, &ab[j * ab_dim1 + 2]);
00454 }
00455 i__3 = j * ab_dim1 + 1;
00456 zlarnd_(&z__2, &c__5, &iseed[1]);
00457 z__1.r = z__2.r * 2., z__1.i = z__2.i * 2.;
00458 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00459
00460 }
00461 }
00462
00463
00464
00465 zlarnv_(&c__2, &iseed[1], n, &b[1]);
00466 iy = izamax_(n, &b[1], &c__1);
00467 bnorm = z_abs(&b[iy]);
00468 bscal = bignum / max(1.,bnorm);
00469 zdscal_(n, &bscal, &b[1], &c__1);
00470
00471 } else if (*imat == 11) {
00472
00473
00474
00475
00476
00477 zlarnv_(&c__2, &iseed[1], n, &b[1]);
00478 tscal = 1. / (doublereal) (*kd + 1);
00479 if (upper) {
00480 i__1 = *n;
00481 for (j = 1; j <= i__1; ++j) {
00482
00483 i__3 = j - 1;
00484 lenj = min(i__3,*kd);
00485 if (lenj > 0) {
00486 zlarnv_(&c__4, &iseed[1], &lenj, &ab[*kd + 2 - lenj + j *
00487 ab_dim1]);
00488 zdscal_(&lenj, &tscal, &ab[*kd + 2 - lenj + j * ab_dim1],
00489 &c__1);
00490 }
00491 i__3 = *kd + 1 + j * ab_dim1;
00492 zlarnd_(&z__1, &c__5, &iseed[1]);
00493 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00494
00495 }
00496 i__1 = *kd + 1 + *n * ab_dim1;
00497 i__3 = *kd + 1 + *n * ab_dim1;
00498 z__1.r = smlnum * ab[i__3].r, z__1.i = smlnum * ab[i__3].i;
00499 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00500 } else {
00501 i__1 = *n;
00502 for (j = 1; j <= i__1; ++j) {
00503
00504 i__3 = *n - j;
00505 lenj = min(i__3,*kd);
00506 if (lenj > 0) {
00507 zlarnv_(&c__4, &iseed[1], &lenj, &ab[j * ab_dim1 + 2]);
00508 zdscal_(&lenj, &tscal, &ab[j * ab_dim1 + 2], &c__1);
00509 }
00510 i__3 = j * ab_dim1 + 1;
00511 zlarnd_(&z__1, &c__5, &iseed[1]);
00512 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00513
00514 }
00515 i__1 = ab_dim1 + 1;
00516 i__3 = ab_dim1 + 1;
00517 z__1.r = smlnum * ab[i__3].r, z__1.i = smlnum * ab[i__3].i;
00518 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00519 }
00520
00521 } else if (*imat == 12) {
00522
00523
00524
00525
00526
00527 zlarnv_(&c__2, &iseed[1], n, &b[1]);
00528 if (upper) {
00529 i__1 = *n;
00530 for (j = 1; j <= i__1; ++j) {
00531
00532 i__3 = j - 1;
00533 lenj = min(i__3,*kd);
00534 if (lenj > 0) {
00535 zlarnv_(&c__4, &iseed[1], &lenj, &ab[*kd + 2 - lenj + j *
00536 ab_dim1]);
00537 }
00538 i__3 = *kd + 1 + j * ab_dim1;
00539 zlarnd_(&z__1, &c__5, &iseed[1]);
00540 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00541
00542 }
00543 i__1 = *kd + 1 + *n * ab_dim1;
00544 i__3 = *kd + 1 + *n * ab_dim1;
00545 z__1.r = smlnum * ab[i__3].r, z__1.i = smlnum * ab[i__3].i;
00546 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00547 } else {
00548 i__1 = *n;
00549 for (j = 1; j <= i__1; ++j) {
00550
00551 i__3 = *n - j;
00552 lenj = min(i__3,*kd);
00553 if (lenj > 0) {
00554 zlarnv_(&c__4, &iseed[1], &lenj, &ab[j * ab_dim1 + 2]);
00555 }
00556 i__3 = j * ab_dim1 + 1;
00557 zlarnd_(&z__1, &c__5, &iseed[1]);
00558 ab[i__3].r = z__1.r, ab[i__3].i = z__1.i;
00559
00560 }
00561 i__1 = ab_dim1 + 1;
00562 i__3 = ab_dim1 + 1;
00563 z__1.r = smlnum * ab[i__3].r, z__1.i = smlnum * ab[i__3].i;
00564 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00565 }
00566
00567 } else if (*imat == 13) {
00568
00569
00570
00571
00572
00573 if (upper) {
00574 jcount = 1;
00575 for (j = *n; j >= 1; --j) {
00576
00577 i__1 = 1, i__3 = *kd + 1 - (j - 1);
00578 i__4 = *kd;
00579 for (i__ = max(i__1,i__3); i__ <= i__4; ++i__) {
00580 i__1 = i__ + j * ab_dim1;
00581 ab[i__1].r = 0., ab[i__1].i = 0.;
00582
00583 }
00584 if (jcount <= 2) {
00585 i__4 = *kd + 1 + j * ab_dim1;
00586 zlarnd_(&z__2, &c__5, &iseed[1]);
00587 z__1.r = smlnum * z__2.r, z__1.i = smlnum * z__2.i;
00588 ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
00589 } else {
00590 i__4 = *kd + 1 + j * ab_dim1;
00591 zlarnd_(&z__1, &c__5, &iseed[1]);
00592 ab[i__4].r = z__1.r, ab[i__4].i = z__1.i;
00593 }
00594 ++jcount;
00595 if (jcount > 4) {
00596 jcount = 1;
00597 }
00598
00599 }
00600 } else {
00601 jcount = 1;
00602 i__4 = *n;
00603 for (j = 1; j <= i__4; ++j) {
00604
00605 i__3 = *n - j + 1, i__2 = *kd + 1;
00606 i__1 = min(i__3,i__2);
00607 for (i__ = 2; i__ <= i__1; ++i__) {
00608 i__3 = i__ + j * ab_dim1;
00609 ab[i__3].r = 0., ab[i__3].i = 0.;
00610
00611 }
00612 if (jcount <= 2) {
00613 i__1 = j * ab_dim1 + 1;
00614 zlarnd_(&z__2, &c__5, &iseed[1]);
00615 z__1.r = smlnum * z__2.r, z__1.i = smlnum * z__2.i;
00616 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00617 } else {
00618 i__1 = j * ab_dim1 + 1;
00619 zlarnd_(&z__1, &c__5, &iseed[1]);
00620 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00621 }
00622 ++jcount;
00623 if (jcount > 4) {
00624 jcount = 1;
00625 }
00626
00627 }
00628 }
00629
00630
00631
00632 if (upper) {
00633 b[1].r = 0., b[1].i = 0.;
00634 for (i__ = *n; i__ >= 2; i__ += -2) {
00635 i__4 = i__;
00636 b[i__4].r = 0., b[i__4].i = 0.;
00637 i__4 = i__ - 1;
00638 zlarnd_(&z__2, &c__5, &iseed[1]);
00639 z__1.r = smlnum * z__2.r, z__1.i = smlnum * z__2.i;
00640 b[i__4].r = z__1.r, b[i__4].i = z__1.i;
00641
00642 }
00643 } else {
00644 i__4 = *n;
00645 b[i__4].r = 0., b[i__4].i = 0.;
00646 i__4 = *n - 1;
00647 for (i__ = 1; i__ <= i__4; i__ += 2) {
00648 i__1 = i__;
00649 b[i__1].r = 0., b[i__1].i = 0.;
00650 i__1 = i__ + 1;
00651 zlarnd_(&z__2, &c__5, &iseed[1]);
00652 z__1.r = smlnum * z__2.r, z__1.i = smlnum * z__2.i;
00653 b[i__1].r = z__1.r, b[i__1].i = z__1.i;
00654
00655 }
00656 }
00657
00658 } else if (*imat == 14) {
00659
00660
00661
00662
00663
00664 texp = 1. / (doublereal) (*kd + 1);
00665 tscal = pow_dd(&smlnum, &texp);
00666 zlarnv_(&c__4, &iseed[1], n, &b[1]);
00667 if (upper) {
00668 i__4 = *n;
00669 for (j = 1; j <= i__4; ++j) {
00670
00671 i__1 = 1, i__3 = *kd + 2 - j;
00672 i__2 = *kd;
00673 for (i__ = max(i__1,i__3); i__ <= i__2; ++i__) {
00674 i__1 = i__ + j * ab_dim1;
00675 ab[i__1].r = 0., ab[i__1].i = 0.;
00676
00677 }
00678 if (j > 1 && *kd > 0) {
00679 i__2 = *kd + j * ab_dim1;
00680 ab[i__2].r = -1., ab[i__2].i = -1.;
00681 }
00682 i__2 = *kd + 1 + j * ab_dim1;
00683 zlarnd_(&z__2, &c__5, &iseed[1]);
00684 z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
00685 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00686
00687 }
00688 i__4 = *n;
00689 b[i__4].r = 1., b[i__4].i = 1.;
00690 } else {
00691 i__4 = *n;
00692 for (j = 1; j <= i__4; ++j) {
00693
00694 i__1 = *n - j + 1, i__3 = *kd + 1;
00695 i__2 = min(i__1,i__3);
00696 for (i__ = 3; i__ <= i__2; ++i__) {
00697 i__1 = i__ + j * ab_dim1;
00698 ab[i__1].r = 0., ab[i__1].i = 0.;
00699
00700 }
00701 if (j < *n && *kd > 0) {
00702 i__2 = j * ab_dim1 + 2;
00703 ab[i__2].r = -1., ab[i__2].i = -1.;
00704 }
00705 i__2 = j * ab_dim1 + 1;
00706 zlarnd_(&z__2, &c__5, &iseed[1]);
00707 z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
00708 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00709
00710 }
00711 b[1].r = 1., b[1].i = 1.;
00712 }
00713
00714 } else if (*imat == 15) {
00715
00716
00717
00718 iy = *n / 2 + 1;
00719 if (upper) {
00720 i__4 = *n;
00721 for (j = 1; j <= i__4; ++j) {
00722
00723 i__2 = j, i__1 = *kd + 1;
00724 lenj = min(i__2,i__1);
00725 zlarnv_(&c__4, &iseed[1], &lenj, &ab[*kd + 2 - lenj + j *
00726 ab_dim1]);
00727 if (j != iy) {
00728 i__2 = *kd + 1 + j * ab_dim1;
00729 zlarnd_(&z__2, &c__5, &iseed[1]);
00730 z__1.r = z__2.r * 2., z__1.i = z__2.i * 2.;
00731 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00732 } else {
00733 i__2 = *kd + 1 + j * ab_dim1;
00734 ab[i__2].r = 0., ab[i__2].i = 0.;
00735 }
00736
00737 }
00738 } else {
00739 i__4 = *n;
00740 for (j = 1; j <= i__4; ++j) {
00741
00742 i__2 = *n - j + 1, i__1 = *kd + 1;
00743 lenj = min(i__2,i__1);
00744 zlarnv_(&c__4, &iseed[1], &lenj, &ab[j * ab_dim1 + 1]);
00745 if (j != iy) {
00746 i__2 = j * ab_dim1 + 1;
00747 zlarnd_(&z__2, &c__5, &iseed[1]);
00748 z__1.r = z__2.r * 2., z__1.i = z__2.i * 2.;
00749 ab[i__2].r = z__1.r, ab[i__2].i = z__1.i;
00750 } else {
00751 i__2 = j * ab_dim1 + 1;
00752 ab[i__2].r = 0., ab[i__2].i = 0.;
00753 }
00754
00755 }
00756 }
00757 zlarnv_(&c__2, &iseed[1], n, &b[1]);
00758 zdscal_(n, &c_b91, &b[1], &c__1);
00759
00760 } else if (*imat == 16) {
00761
00762
00763
00764
00765
00766
00767 tscal = unfl / ulp;
00768 tscal = (1. - ulp) / tscal;
00769 i__4 = *n;
00770 for (j = 1; j <= i__4; ++j) {
00771 i__2 = *kd + 1;
00772 for (i__ = 1; i__ <= i__2; ++i__) {
00773 i__1 = i__ + j * ab_dim1;
00774 ab[i__1].r = 0., ab[i__1].i = 0.;
00775
00776 }
00777
00778 }
00779 texp = 1.;
00780 if (*kd > 0) {
00781 if (upper) {
00782 i__4 = -(*kd);
00783 for (j = *n; i__4 < 0 ? j >= 1 : j <= 1; j += i__4) {
00784
00785 i__1 = 1, i__3 = j - *kd + 1;
00786 i__2 = max(i__1,i__3);
00787 for (i__ = j; i__ >= i__2; i__ += -2) {
00788 i__1 = j - i__ + 1 + i__ * ab_dim1;
00789 d__1 = -tscal / (doublereal) (*kd + 2);
00790 ab[i__1].r = d__1, ab[i__1].i = 0.;
00791 i__1 = *kd + 1 + i__ * ab_dim1;
00792 ab[i__1].r = 1., ab[i__1].i = 0.;
00793 i__1 = i__;
00794 d__1 = texp * (1. - ulp);
00795 b[i__1].r = d__1, b[i__1].i = 0.;
00796
00797 i__1 = 1, i__3 = j - *kd + 1;
00798 if (i__ > max(i__1,i__3)) {
00799 i__1 = j - i__ + 2 + (i__ - 1) * ab_dim1;
00800 d__1 = -(tscal / (doublereal) (*kd + 2)) / (
00801 doublereal) (*kd + 3);
00802 ab[i__1].r = d__1, ab[i__1].i = 0.;
00803 i__1 = *kd + 1 + (i__ - 1) * ab_dim1;
00804 ab[i__1].r = 1., ab[i__1].i = 0.;
00805 i__1 = i__ - 1;
00806 d__1 = texp * (doublereal) ((*kd + 1) * (*kd + 1)
00807 + *kd);
00808 b[i__1].r = d__1, b[i__1].i = 0.;
00809 }
00810 texp *= 2.;
00811
00812 }
00813
00814 i__1 = 1, i__3 = j - *kd + 1;
00815 i__2 = max(i__1,i__3);
00816 d__1 = (doublereal) (*kd + 2) / (doublereal) (*kd + 3) *
00817 tscal;
00818 b[i__2].r = d__1, b[i__2].i = 0.;
00819
00820 }
00821 } else {
00822 i__4 = *n;
00823 i__2 = *kd;
00824 for (j = 1; i__2 < 0 ? j >= i__4 : j <= i__4; j += i__2) {
00825 texp = 1.;
00826
00827 i__1 = *kd + 1, i__3 = *n - j + 1;
00828 lenj = min(i__1,i__3);
00829
00830 i__3 = *n, i__5 = j + *kd - 1;
00831 i__1 = min(i__3,i__5);
00832 for (i__ = j; i__ <= i__1; i__ += 2) {
00833 i__3 = lenj - (i__ - j) + j * ab_dim1;
00834 d__1 = -tscal / (doublereal) (*kd + 2);
00835 ab[i__3].r = d__1, ab[i__3].i = 0.;
00836 i__3 = j * ab_dim1 + 1;
00837 ab[i__3].r = 1., ab[i__3].i = 0.;
00838 i__3 = j;
00839 d__1 = texp * (1. - ulp);
00840 b[i__3].r = d__1, b[i__3].i = 0.;
00841
00842 i__3 = *n, i__5 = j + *kd - 1;
00843 if (i__ < min(i__3,i__5)) {
00844 i__3 = lenj - (i__ - j + 1) + (i__ + 1) * ab_dim1;
00845 d__1 = -(tscal / (doublereal) (*kd + 2)) / (
00846 doublereal) (*kd + 3);
00847 ab[i__3].r = d__1, ab[i__3].i = 0.;
00848 i__3 = (i__ + 1) * ab_dim1 + 1;
00849 ab[i__3].r = 1., ab[i__3].i = 0.;
00850 i__3 = i__ + 1;
00851 d__1 = texp * (doublereal) ((*kd + 1) * (*kd + 1)
00852 + *kd);
00853 b[i__3].r = d__1, b[i__3].i = 0.;
00854 }
00855 texp *= 2.;
00856
00857 }
00858
00859 i__3 = *n, i__5 = j + *kd - 1;
00860 i__1 = min(i__3,i__5);
00861 d__1 = (doublereal) (*kd + 2) / (doublereal) (*kd + 3) *
00862 tscal;
00863 b[i__1].r = d__1, b[i__1].i = 0.;
00864
00865 }
00866 }
00867 }
00868
00869 } else if (*imat == 17) {
00870
00871
00872
00873
00874
00875 if (upper) {
00876 i__2 = *n;
00877 for (j = 1; j <= i__2; ++j) {
00878
00879 i__4 = j - 1;
00880 lenj = min(i__4,*kd);
00881 zlarnv_(&c__4, &iseed[1], &lenj, &ab[*kd + 1 - lenj + j *
00882 ab_dim1]);
00883 i__4 = *kd + 1 + j * ab_dim1;
00884 d__1 = (doublereal) j;
00885 ab[i__4].r = d__1, ab[i__4].i = 0.;
00886
00887 }
00888 } else {
00889 i__2 = *n;
00890 for (j = 1; j <= i__2; ++j) {
00891
00892 i__4 = *n - j;
00893 lenj = min(i__4,*kd);
00894 if (lenj > 0) {
00895 zlarnv_(&c__4, &iseed[1], &lenj, &ab[j * ab_dim1 + 2]);
00896 }
00897 i__4 = j * ab_dim1 + 1;
00898 d__1 = (doublereal) j;
00899 ab[i__4].r = d__1, ab[i__4].i = 0.;
00900
00901 }
00902 }
00903
00904
00905
00906 zlarnv_(&c__2, &iseed[1], n, &b[1]);
00907 iy = izamax_(n, &b[1], &c__1);
00908 bnorm = z_abs(&b[iy]);
00909 bscal = bignum / max(1.,bnorm);
00910 zdscal_(n, &bscal, &b[1], &c__1);
00911
00912 } else if (*imat == 18) {
00913
00914
00915
00916
00917
00918
00919 tleft = bignum / (doublereal) (*kd + 1);
00920 tscal = bignum * ((doublereal) (*kd + 1) / (doublereal) (*kd + 2));
00921 if (upper) {
00922 i__2 = *n;
00923 for (j = 1; j <= i__2; ++j) {
00924
00925 i__4 = j, i__1 = *kd + 1;
00926 lenj = min(i__4,i__1);
00927 zlarnv_(&c__5, &iseed[1], &lenj, &ab[*kd + 2 - lenj + j *
00928 ab_dim1]);
00929 dlarnv_(&c__1, &iseed[1], &lenj, &rwork[*kd + 2 - lenj]);
00930 i__4 = *kd + 1;
00931 for (i__ = *kd + 2 - lenj; i__ <= i__4; ++i__) {
00932 i__1 = i__ + j * ab_dim1;
00933 i__3 = i__ + j * ab_dim1;
00934 d__1 = tleft + rwork[i__] * tscal;
00935 z__1.r = d__1 * ab[i__3].r, z__1.i = d__1 * ab[i__3].i;
00936 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00937
00938 }
00939
00940 }
00941 } else {
00942 i__2 = *n;
00943 for (j = 1; j <= i__2; ++j) {
00944
00945 i__4 = *n - j + 1, i__1 = *kd + 1;
00946 lenj = min(i__4,i__1);
00947 zlarnv_(&c__5, &iseed[1], &lenj, &ab[j * ab_dim1 + 1]);
00948 dlarnv_(&c__1, &iseed[1], &lenj, &rwork[1]);
00949 i__4 = lenj;
00950 for (i__ = 1; i__ <= i__4; ++i__) {
00951 i__1 = i__ + j * ab_dim1;
00952 i__3 = i__ + j * ab_dim1;
00953 d__1 = tleft + rwork[i__] * tscal;
00954 z__1.r = d__1 * ab[i__3].r, z__1.i = d__1 * ab[i__3].i;
00955 ab[i__1].r = z__1.r, ab[i__1].i = z__1.i;
00956
00957 }
00958
00959 }
00960 }
00961 zlarnv_(&c__2, &iseed[1], n, &b[1]);
00962 zdscal_(n, &c_b91, &b[1], &c__1);
00963 }
00964
00965
00966
00967 if (! lsame_(trans, "N")) {
00968 if (upper) {
00969 i__2 = *n / 2;
00970 for (j = 1; j <= i__2; ++j) {
00971
00972 i__4 = *n - (j << 1) + 1, i__1 = *kd + 1;
00973 lenj = min(i__4,i__1);
00974 i__4 = *ldab - 1;
00975 zswap_(&lenj, &ab[*kd + 1 + j * ab_dim1], &i__4, &ab[*kd + 2
00976 - lenj + (*n - j + 1) * ab_dim1], &c_n1);
00977
00978 }
00979 } else {
00980 i__2 = *n / 2;
00981 for (j = 1; j <= i__2; ++j) {
00982
00983 i__4 = *n - (j << 1) + 1, i__1 = *kd + 1;
00984 lenj = min(i__4,i__1);
00985 i__4 = -(*ldab) + 1;
00986 zswap_(&lenj, &ab[j * ab_dim1 + 1], &c__1, &ab[lenj + (*n - j
00987 + 2 - lenj) * ab_dim1], &i__4);
00988
00989 }
00990 }
00991 }
00992
00993 return 0;
00994
00995
00996
00997 }