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__0 = 0;
00019 static integer c__1 = 1;
00020
00021 int zlatmr_(integer *m, integer *n, char *dist, integer *
00022 iseed, char *sym, doublecomplex *d__, integer *mode, doublereal *cond,
00023 doublecomplex *dmax__, char *rsign, char *grade, doublecomplex *dl,
00024 integer *model, doublereal *condl, doublecomplex *dr, integer *moder,
00025 doublereal *condr, char *pivtng, integer *ipivot, integer *kl,
00026 integer *ku, doublereal *sparse, doublereal *anorm, char *pack,
00027 doublecomplex *a, integer *lda, integer *iwork, integer *info)
00028 {
00029
00030 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
00031 doublereal d__1, d__2;
00032 doublecomplex z__1, z__2;
00033
00034
00035 double z_abs(doublecomplex *);
00036 void d_cnjg(doublecomplex *, doublecomplex *);
00037
00038
00039 integer i__, j, k, kll, kuu, isub, jsub;
00040 doublereal temp;
00041 integer isym, ipack;
00042 extern logical lsame_(char *, char *);
00043 doublereal tempa[1];
00044 doublecomplex ctemp;
00045 integer iisub, idist, jjsub, mnmin;
00046 logical dzero;
00047 integer mnsub;
00048 doublereal onorm;
00049 integer mxsub, npvts;
00050 extern int zlatm1_(integer *, doublereal *, integer *,
00051 integer *, integer *, doublecomplex *, integer *, integer *);
00052 extern VOID zlatm2_(doublecomplex *, integer *,
00053 integer *, integer *, integer *, integer *, integer *, integer *,
00054 integer *, doublecomplex *, integer *, doublecomplex *,
00055 doublecomplex *, integer *, integer *, doublereal *), zlatm3_(
00056 doublecomplex *, integer *, integer *, integer *, integer *,
00057 integer *, integer *, integer *, integer *, integer *, integer *,
00058 doublecomplex *, integer *, doublecomplex *, doublecomplex *,
00059 integer *, integer *, doublereal *);
00060 doublecomplex calpha;
00061 integer igrade;
00062 logical fulbnd;
00063 extern doublereal zlangb_(char *, integer *, integer *, integer *,
00064 doublecomplex *, integer *, doublereal *);
00065 extern int xerbla_(char *, integer *);
00066 logical badpvt;
00067 extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
00068 integer *, doublereal *);
00069 extern int zdscal_(integer *, doublereal *,
00070 doublecomplex *, integer *);
00071 extern doublereal zlansb_(char *, char *, integer *, integer *,
00072 doublecomplex *, integer *, doublereal *);
00073 integer irsign, ipvtng;
00074 extern doublereal zlansp_(char *, char *, integer *, doublecomplex *,
00075 doublereal *), zlansy_(char *, char *, integer *,
00076 doublecomplex *, integer *, doublereal *);
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
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468 --iseed;
00469 --d__;
00470 --dl;
00471 --dr;
00472 --ipivot;
00473 a_dim1 = *lda;
00474 a_offset = 1 + a_dim1;
00475 a -= a_offset;
00476 --iwork;
00477
00478
00479 *info = 0;
00480
00481
00482
00483 if (*m == 0 || *n == 0) {
00484 return 0;
00485 }
00486
00487
00488
00489 if (lsame_(dist, "U")) {
00490 idist = 1;
00491 } else if (lsame_(dist, "S")) {
00492 idist = 2;
00493 } else if (lsame_(dist, "N")) {
00494 idist = 3;
00495 } else if (lsame_(dist, "D")) {
00496 idist = 4;
00497 } else {
00498 idist = -1;
00499 }
00500
00501
00502
00503 if (lsame_(sym, "H")) {
00504 isym = 0;
00505 } else if (lsame_(sym, "N")) {
00506 isym = 1;
00507 } else if (lsame_(sym, "S")) {
00508 isym = 2;
00509 } else {
00510 isym = -1;
00511 }
00512
00513
00514
00515 if (lsame_(rsign, "F")) {
00516 irsign = 0;
00517 } else if (lsame_(rsign, "T")) {
00518 irsign = 1;
00519 } else {
00520 irsign = -1;
00521 }
00522
00523
00524
00525 if (lsame_(pivtng, "N")) {
00526 ipvtng = 0;
00527 } else if (lsame_(pivtng, " ")) {
00528 ipvtng = 0;
00529 } else if (lsame_(pivtng, "L")) {
00530 ipvtng = 1;
00531 npvts = *m;
00532 } else if (lsame_(pivtng, "R")) {
00533 ipvtng = 2;
00534 npvts = *n;
00535 } else if (lsame_(pivtng, "B")) {
00536 ipvtng = 3;
00537 npvts = min(*n,*m);
00538 } else if (lsame_(pivtng, "F")) {
00539 ipvtng = 3;
00540 npvts = min(*n,*m);
00541 } else {
00542 ipvtng = -1;
00543 }
00544
00545
00546
00547 if (lsame_(grade, "N")) {
00548 igrade = 0;
00549 } else if (lsame_(grade, "L")) {
00550 igrade = 1;
00551 } else if (lsame_(grade, "R")) {
00552 igrade = 2;
00553 } else if (lsame_(grade, "B")) {
00554 igrade = 3;
00555 } else if (lsame_(grade, "E")) {
00556 igrade = 4;
00557 } else if (lsame_(grade, "H")) {
00558 igrade = 5;
00559 } else if (lsame_(grade, "S")) {
00560 igrade = 6;
00561 } else {
00562 igrade = -1;
00563 }
00564
00565
00566
00567 if (lsame_(pack, "N")) {
00568 ipack = 0;
00569 } else if (lsame_(pack, "U")) {
00570 ipack = 1;
00571 } else if (lsame_(pack, "L")) {
00572 ipack = 2;
00573 } else if (lsame_(pack, "C")) {
00574 ipack = 3;
00575 } else if (lsame_(pack, "R")) {
00576 ipack = 4;
00577 } else if (lsame_(pack, "B")) {
00578 ipack = 5;
00579 } else if (lsame_(pack, "Q")) {
00580 ipack = 6;
00581 } else if (lsame_(pack, "Z")) {
00582 ipack = 7;
00583 } else {
00584 ipack = -1;
00585 }
00586
00587
00588
00589 mnmin = min(*m,*n);
00590
00591 i__1 = *kl, i__2 = *m - 1;
00592 kll = min(i__1,i__2);
00593
00594 i__1 = *ku, i__2 = *n - 1;
00595 kuu = min(i__1,i__2);
00596
00597
00598
00599 dzero = FALSE_;
00600 if (igrade == 4 && *model == 0) {
00601 i__1 = *m;
00602 for (i__ = 1; i__ <= i__1; ++i__) {
00603 i__2 = i__;
00604 if (dl[i__2].r == 0. && dl[i__2].i == 0.) {
00605 dzero = TRUE_;
00606 }
00607
00608 }
00609 }
00610
00611
00612
00613 badpvt = FALSE_;
00614 if (ipvtng > 0) {
00615 i__1 = npvts;
00616 for (j = 1; j <= i__1; ++j) {
00617 if (ipivot[j] <= 0 || ipivot[j] > npvts) {
00618 badpvt = TRUE_;
00619 }
00620
00621 }
00622 }
00623
00624
00625
00626 if (*m < 0) {
00627 *info = -1;
00628 } else if (*m != *n && (isym == 0 || isym == 2)) {
00629 *info = -1;
00630 } else if (*n < 0) {
00631 *info = -2;
00632 } else if (idist == -1) {
00633 *info = -3;
00634 } else if (isym == -1) {
00635 *info = -5;
00636 } else if (*mode < -6 || *mode > 6) {
00637 *info = -7;
00638 } else if (*mode != -6 && *mode != 0 && *mode != 6 && *cond < 1.) {
00639 *info = -8;
00640 } else if (*mode != -6 && *mode != 0 && *mode != 6 && irsign == -1) {
00641 *info = -10;
00642 } else if (igrade == -1 || igrade == 4 && *m != *n || (igrade == 1 ||
00643 igrade == 2 || igrade == 3 || igrade == 4 || igrade == 6) && isym
00644 == 0 || (igrade == 1 || igrade == 2 || igrade == 3 || igrade == 4
00645 || igrade == 5) && isym == 2) {
00646 *info = -11;
00647 } else if (igrade == 4 && dzero) {
00648 *info = -12;
00649 } else if ((igrade == 1 || igrade == 3 || igrade == 4 || igrade == 5 ||
00650 igrade == 6) && (*model < -6 || *model > 6)) {
00651 *info = -13;
00652 } else if ((igrade == 1 || igrade == 3 || igrade == 4 || igrade == 5 ||
00653 igrade == 6) && (*model != -6 && *model != 0 && *model != 6) && *
00654 condl < 1.) {
00655 *info = -14;
00656 } else if ((igrade == 2 || igrade == 3) && (*moder < -6 || *moder > 6)) {
00657 *info = -16;
00658 } else if ((igrade == 2 || igrade == 3) && (*moder != -6 && *moder != 0 &&
00659 *moder != 6) && *condr < 1.) {
00660 *info = -17;
00661 } else if (ipvtng == -1 || ipvtng == 3 && *m != *n || (ipvtng == 1 ||
00662 ipvtng == 2) && (isym == 0 || isym == 2)) {
00663 *info = -18;
00664 } else if (ipvtng != 0 && badpvt) {
00665 *info = -19;
00666 } else if (*kl < 0) {
00667 *info = -20;
00668 } else if (*ku < 0 || (isym == 0 || isym == 2) && *kl != *ku) {
00669 *info = -21;
00670 } else if (*sparse < 0. || *sparse > 1.) {
00671 *info = -22;
00672 } else if (ipack == -1 || (ipack == 1 || ipack == 2 || ipack == 5 ||
00673 ipack == 6) && isym == 1 || ipack == 3 && isym == 1 && (*kl != 0
00674 || *m != *n) || ipack == 4 && isym == 1 && (*ku != 0 || *m != *n))
00675 {
00676 *info = -24;
00677 } else if ((ipack == 0 || ipack == 1 || ipack == 2) && *lda < max(1,*m) ||
00678 (ipack == 3 || ipack == 4) && *lda < 1 || (ipack == 5 || ipack ==
00679 6) && *lda < kuu + 1 || ipack == 7 && *lda < kll + kuu + 1) {
00680 *info = -26;
00681 }
00682
00683 if (*info != 0) {
00684 i__1 = -(*info);
00685 xerbla_("ZLATMR", &i__1);
00686 return 0;
00687 }
00688
00689
00690
00691 fulbnd = FALSE_;
00692 if (kuu == *n - 1 && kll == *m - 1) {
00693 fulbnd = TRUE_;
00694 }
00695
00696
00697
00698 for (i__ = 1; i__ <= 4; ++i__) {
00699 iseed[i__] = (i__1 = iseed[i__], abs(i__1)) % 4096;
00700
00701 }
00702
00703 iseed[4] = (iseed[4] / 2 << 1) + 1;
00704
00705
00706
00707
00708
00709 zlatm1_(mode, cond, &irsign, &idist, &iseed[1], &d__[1], &mnmin, info);
00710 if (*info != 0) {
00711 *info = 1;
00712 return 0;
00713 }
00714 if (*mode != 0 && *mode != -6 && *mode != 6) {
00715
00716
00717
00718 temp = z_abs(&d__[1]);
00719 i__1 = mnmin;
00720 for (i__ = 2; i__ <= i__1; ++i__) {
00721
00722 d__1 = temp, d__2 = z_abs(&d__[i__]);
00723 temp = max(d__1,d__2);
00724
00725 }
00726 if (temp == 0. && (dmax__->r != 0. || dmax__->i != 0.)) {
00727 *info = 2;
00728 return 0;
00729 }
00730 if (temp != 0.) {
00731 z__1.r = dmax__->r / temp, z__1.i = dmax__->i / temp;
00732 calpha.r = z__1.r, calpha.i = z__1.i;
00733 } else {
00734 calpha.r = 1., calpha.i = 0.;
00735 }
00736 i__1 = mnmin;
00737 for (i__ = 1; i__ <= i__1; ++i__) {
00738 i__2 = i__;
00739 i__3 = i__;
00740 z__1.r = calpha.r * d__[i__3].r - calpha.i * d__[i__3].i, z__1.i =
00741 calpha.r * d__[i__3].i + calpha.i * d__[i__3].r;
00742 d__[i__2].r = z__1.r, d__[i__2].i = z__1.i;
00743
00744 }
00745
00746 }
00747
00748
00749
00750 if (isym == 0) {
00751 i__1 = mnmin;
00752 for (i__ = 1; i__ <= i__1; ++i__) {
00753 i__2 = i__;
00754 i__3 = i__;
00755 d__1 = d__[i__3].r;
00756 d__[i__2].r = d__1, d__[i__2].i = 0.;
00757
00758 }
00759 }
00760
00761
00762
00763 if (igrade == 1 || igrade == 3 || igrade == 4 || igrade == 5 || igrade ==
00764 6) {
00765 zlatm1_(model, condl, &c__0, &idist, &iseed[1], &dl[1], m, info);
00766 if (*info != 0) {
00767 *info = 3;
00768 return 0;
00769 }
00770 }
00771
00772
00773
00774 if (igrade == 2 || igrade == 3) {
00775 zlatm1_(moder, condr, &c__0, &idist, &iseed[1], &dr[1], n, info);
00776 if (*info != 0) {
00777 *info = 4;
00778 return 0;
00779 }
00780 }
00781
00782
00783
00784 if (ipvtng > 0) {
00785 i__1 = npvts;
00786 for (i__ = 1; i__ <= i__1; ++i__) {
00787 iwork[i__] = i__;
00788
00789 }
00790 if (fulbnd) {
00791 i__1 = npvts;
00792 for (i__ = 1; i__ <= i__1; ++i__) {
00793 k = ipivot[i__];
00794 j = iwork[i__];
00795 iwork[i__] = iwork[k];
00796 iwork[k] = j;
00797
00798 }
00799 } else {
00800 for (i__ = npvts; i__ >= 1; --i__) {
00801 k = ipivot[i__];
00802 j = iwork[i__];
00803 iwork[i__] = iwork[k];
00804 iwork[k] = j;
00805
00806 }
00807 }
00808 }
00809
00810
00811
00812
00813
00814
00815 if (fulbnd) {
00816
00817
00818
00819
00820 if (ipack == 0) {
00821 if (isym == 0) {
00822 i__1 = *n;
00823 for (j = 1; j <= i__1; ++j) {
00824 i__2 = j;
00825 for (i__ = 1; i__ <= i__2; ++i__) {
00826 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00827 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
00828 dr[1], &ipvtng, &iwork[1], sparse);
00829 ctemp.r = z__1.r, ctemp.i = z__1.i;
00830 i__3 = isub + jsub * a_dim1;
00831 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00832 i__3 = jsub + isub * a_dim1;
00833 d_cnjg(&z__1, &ctemp);
00834 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00835
00836 }
00837
00838 }
00839 } else if (isym == 1) {
00840 i__1 = *n;
00841 for (j = 1; j <= i__1; ++j) {
00842 i__2 = *m;
00843 for (i__ = 1; i__ <= i__2; ++i__) {
00844 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00845 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
00846 dr[1], &ipvtng, &iwork[1], sparse);
00847 ctemp.r = z__1.r, ctemp.i = z__1.i;
00848 i__3 = isub + jsub * a_dim1;
00849 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00850
00851 }
00852
00853 }
00854 } else if (isym == 2) {
00855 i__1 = *n;
00856 for (j = 1; j <= i__1; ++j) {
00857 i__2 = j;
00858 for (i__ = 1; i__ <= i__2; ++i__) {
00859 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00860 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
00861 dr[1], &ipvtng, &iwork[1], sparse);
00862 ctemp.r = z__1.r, ctemp.i = z__1.i;
00863 i__3 = isub + jsub * a_dim1;
00864 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00865 i__3 = jsub + isub * a_dim1;
00866 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00867
00868 }
00869
00870 }
00871 }
00872
00873 } else if (ipack == 1) {
00874
00875 i__1 = *n;
00876 for (j = 1; j <= i__1; ++j) {
00877 i__2 = j;
00878 for (i__ = 1; i__ <= i__2; ++i__) {
00879 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00880 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00881 , &ipvtng, &iwork[1], sparse);
00882 ctemp.r = z__1.r, ctemp.i = z__1.i;
00883 mnsub = min(isub,jsub);
00884 mxsub = max(isub,jsub);
00885 if (mxsub == isub && isym == 0) {
00886 i__3 = mnsub + mxsub * a_dim1;
00887 d_cnjg(&z__1, &ctemp);
00888 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00889 } else {
00890 i__3 = mnsub + mxsub * a_dim1;
00891 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00892 }
00893 if (mnsub != mxsub) {
00894 i__3 = mxsub + mnsub * a_dim1;
00895 a[i__3].r = 0., a[i__3].i = 0.;
00896 }
00897
00898 }
00899
00900 }
00901
00902 } else if (ipack == 2) {
00903
00904 i__1 = *n;
00905 for (j = 1; j <= i__1; ++j) {
00906 i__2 = j;
00907 for (i__ = 1; i__ <= i__2; ++i__) {
00908 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00909 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00910 , &ipvtng, &iwork[1], sparse);
00911 ctemp.r = z__1.r, ctemp.i = z__1.i;
00912 mnsub = min(isub,jsub);
00913 mxsub = max(isub,jsub);
00914 if (mxsub == jsub && isym == 0) {
00915 i__3 = mxsub + mnsub * a_dim1;
00916 d_cnjg(&z__1, &ctemp);
00917 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00918 } else {
00919 i__3 = mxsub + mnsub * a_dim1;
00920 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00921 }
00922 if (mnsub != mxsub) {
00923 i__3 = mnsub + mxsub * a_dim1;
00924 a[i__3].r = 0., a[i__3].i = 0.;
00925 }
00926
00927 }
00928
00929 }
00930
00931 } else if (ipack == 3) {
00932
00933 i__1 = *n;
00934 for (j = 1; j <= i__1; ++j) {
00935 i__2 = j;
00936 for (i__ = 1; i__ <= i__2; ++i__) {
00937 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00938 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00939 , &ipvtng, &iwork[1], sparse);
00940 ctemp.r = z__1.r, ctemp.i = z__1.i;
00941
00942
00943
00944
00945 mnsub = min(isub,jsub);
00946 mxsub = max(isub,jsub);
00947 k = mxsub * (mxsub - 1) / 2 + mnsub;
00948
00949
00950
00951 jjsub = (k - 1) / *lda + 1;
00952 iisub = k - *lda * (jjsub - 1);
00953
00954 if (mxsub == isub && isym == 0) {
00955 i__3 = iisub + jjsub * a_dim1;
00956 d_cnjg(&z__1, &ctemp);
00957 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00958 } else {
00959 i__3 = iisub + jjsub * a_dim1;
00960 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00961 }
00962
00963 }
00964
00965 }
00966
00967 } else if (ipack == 4) {
00968
00969 i__1 = *n;
00970 for (j = 1; j <= i__1; ++j) {
00971 i__2 = j;
00972 for (i__ = 1; i__ <= i__2; ++i__) {
00973 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00974 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00975 , &ipvtng, &iwork[1], sparse);
00976 ctemp.r = z__1.r, ctemp.i = z__1.i;
00977
00978
00979
00980 mnsub = min(isub,jsub);
00981 mxsub = max(isub,jsub);
00982 if (mnsub == 1) {
00983 k = mxsub;
00984 } else {
00985 k = *n * (*n + 1) / 2 - (*n - mnsub + 1) * (*n -
00986 mnsub + 2) / 2 + mxsub - mnsub + 1;
00987 }
00988
00989
00990
00991 jjsub = (k - 1) / *lda + 1;
00992 iisub = k - *lda * (jjsub - 1);
00993
00994 if (mxsub == jsub && isym == 0) {
00995 i__3 = iisub + jjsub * a_dim1;
00996 d_cnjg(&z__1, &ctemp);
00997 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00998 } else {
00999 i__3 = iisub + jjsub * a_dim1;
01000 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01001 }
01002
01003 }
01004
01005 }
01006
01007 } else if (ipack == 5) {
01008
01009 i__1 = *n;
01010 for (j = 1; j <= i__1; ++j) {
01011 i__2 = j;
01012 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01013 if (i__ < 1) {
01014 i__3 = j - i__ + 1 + (i__ + *n) * a_dim1;
01015 a[i__3].r = 0., a[i__3].i = 0.;
01016 } else {
01017 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01018 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
01019 dr[1], &ipvtng, &iwork[1], sparse);
01020 ctemp.r = z__1.r, ctemp.i = z__1.i;
01021 mnsub = min(isub,jsub);
01022 mxsub = max(isub,jsub);
01023 if (mxsub == jsub && isym == 0) {
01024 i__3 = mxsub - mnsub + 1 + mnsub * a_dim1;
01025 d_cnjg(&z__1, &ctemp);
01026 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01027 } else {
01028 i__3 = mxsub - mnsub + 1 + mnsub * a_dim1;
01029 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01030 }
01031 }
01032
01033 }
01034
01035 }
01036
01037 } else if (ipack == 6) {
01038
01039 i__1 = *n;
01040 for (j = 1; j <= i__1; ++j) {
01041 i__2 = j;
01042 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01043 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01044 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
01045 , &ipvtng, &iwork[1], sparse);
01046 ctemp.r = z__1.r, ctemp.i = z__1.i;
01047 mnsub = min(isub,jsub);
01048 mxsub = max(isub,jsub);
01049 if (mxsub == isub && isym == 0) {
01050 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01051 d_cnjg(&z__1, &ctemp);
01052 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01053 } else {
01054 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01055 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01056 }
01057
01058 }
01059
01060 }
01061
01062 } else if (ipack == 7) {
01063
01064 if (isym != 1) {
01065 i__1 = *n;
01066 for (j = 1; j <= i__1; ++j) {
01067 i__2 = j;
01068 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01069 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01070 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
01071 dr[1], &ipvtng, &iwork[1], sparse);
01072 ctemp.r = z__1.r, ctemp.i = z__1.i;
01073 mnsub = min(isub,jsub);
01074 mxsub = max(isub,jsub);
01075 if (i__ < 1) {
01076 i__3 = j - i__ + 1 + kuu + (i__ + *n) * a_dim1;
01077 a[i__3].r = 0., a[i__3].i = 0.;
01078 }
01079 if (mxsub == isub && isym == 0) {
01080 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01081 d_cnjg(&z__1, &ctemp);
01082 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01083 } else {
01084 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01085 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01086 }
01087 if (i__ >= 1 && mnsub != mxsub) {
01088 if (mnsub == isub && isym == 0) {
01089 i__3 = mxsub - mnsub + 1 + kuu + mnsub *
01090 a_dim1;
01091 d_cnjg(&z__1, &ctemp);
01092 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01093 } else {
01094 i__3 = mxsub - mnsub + 1 + kuu + mnsub *
01095 a_dim1;
01096 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01097 }
01098 }
01099
01100 }
01101
01102 }
01103 } else if (isym == 1) {
01104 i__1 = *n;
01105 for (j = 1; j <= i__1; ++j) {
01106 i__2 = j + kll;
01107 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01108 zlatm3_(&z__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01109 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
01110 dr[1], &ipvtng, &iwork[1], sparse);
01111 ctemp.r = z__1.r, ctemp.i = z__1.i;
01112 i__3 = isub - jsub + kuu + 1 + jsub * a_dim1;
01113 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01114
01115 }
01116
01117 }
01118 }
01119
01120 }
01121
01122 } else {
01123
01124
01125
01126 if (ipack == 0) {
01127 if (isym == 0) {
01128 i__1 = *n;
01129 for (j = 1; j <= i__1; ++j) {
01130 i__2 = j;
01131 for (i__ = 1; i__ <= i__2; ++i__) {
01132 i__3 = i__ + j * a_dim1;
01133 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01134 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01135 &iwork[1], sparse);
01136 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01137 i__3 = j + i__ * a_dim1;
01138 d_cnjg(&z__1, &a[i__ + j * a_dim1]);
01139 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01140
01141 }
01142
01143 }
01144 } else if (isym == 1) {
01145 i__1 = *n;
01146 for (j = 1; j <= i__1; ++j) {
01147 i__2 = *m;
01148 for (i__ = 1; i__ <= i__2; ++i__) {
01149 i__3 = i__ + j * a_dim1;
01150 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01151 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01152 &iwork[1], sparse);
01153 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01154
01155 }
01156
01157 }
01158 } else if (isym == 2) {
01159 i__1 = *n;
01160 for (j = 1; j <= i__1; ++j) {
01161 i__2 = j;
01162 for (i__ = 1; i__ <= i__2; ++i__) {
01163 i__3 = i__ + j * a_dim1;
01164 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01165 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01166 &iwork[1], sparse);
01167 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01168 i__3 = j + i__ * a_dim1;
01169 i__4 = i__ + j * a_dim1;
01170 a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
01171
01172 }
01173
01174 }
01175 }
01176
01177 } else if (ipack == 1) {
01178
01179 i__1 = *n;
01180 for (j = 1; j <= i__1; ++j) {
01181 i__2 = j;
01182 for (i__ = 1; i__ <= i__2; ++i__) {
01183 i__3 = i__ + j * a_dim1;
01184 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[1],
01185 &d__[1], &igrade, &dl[1], &dr[1], &ipvtng, &iwork[
01186 1], sparse);
01187 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01188 if (i__ != j) {
01189 i__3 = j + i__ * a_dim1;
01190 a[i__3].r = 0., a[i__3].i = 0.;
01191 }
01192
01193 }
01194
01195 }
01196
01197 } else if (ipack == 2) {
01198
01199 i__1 = *n;
01200 for (j = 1; j <= i__1; ++j) {
01201 i__2 = j;
01202 for (i__ = 1; i__ <= i__2; ++i__) {
01203 if (isym == 0) {
01204 i__3 = j + i__ * a_dim1;
01205 zlatm2_(&z__2, m, n, &i__, &j, kl, ku, &idist, &iseed[
01206 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01207 &iwork[1], sparse);
01208 d_cnjg(&z__1, &z__2);
01209 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01210 } else {
01211 i__3 = j + i__ * a_dim1;
01212 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01213 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01214 &iwork[1], sparse);
01215 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01216 }
01217 if (i__ != j) {
01218 i__3 = i__ + j * a_dim1;
01219 a[i__3].r = 0., a[i__3].i = 0.;
01220 }
01221
01222 }
01223
01224 }
01225
01226 } else if (ipack == 3) {
01227
01228 isub = 0;
01229 jsub = 1;
01230 i__1 = *n;
01231 for (j = 1; j <= i__1; ++j) {
01232 i__2 = j;
01233 for (i__ = 1; i__ <= i__2; ++i__) {
01234 ++isub;
01235 if (isub > *lda) {
01236 isub = 1;
01237 ++jsub;
01238 }
01239 i__3 = isub + jsub * a_dim1;
01240 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[1],
01241 &d__[1], &igrade, &dl[1], &dr[1], &ipvtng, &iwork[
01242 1], sparse);
01243 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01244
01245 }
01246
01247 }
01248
01249 } else if (ipack == 4) {
01250
01251 if (isym == 0 || isym == 2) {
01252 i__1 = *n;
01253 for (j = 1; j <= i__1; ++j) {
01254 i__2 = j;
01255 for (i__ = 1; i__ <= i__2; ++i__) {
01256
01257
01258
01259 if (i__ == 1) {
01260 k = j;
01261 } else {
01262 k = *n * (*n + 1) / 2 - (*n - i__ + 1) * (*n -
01263 i__ + 2) / 2 + j - i__ + 1;
01264 }
01265
01266
01267
01268 jsub = (k - 1) / *lda + 1;
01269 isub = k - *lda * (jsub - 1);
01270
01271 i__3 = isub + jsub * a_dim1;
01272 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01273 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01274 &iwork[1], sparse);
01275 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01276 if (isym == 0) {
01277 i__3 = isub + jsub * a_dim1;
01278 d_cnjg(&z__1, &a[isub + jsub * a_dim1]);
01279 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01280 }
01281
01282 }
01283
01284 }
01285 } else {
01286 isub = 0;
01287 jsub = 1;
01288 i__1 = *n;
01289 for (j = 1; j <= i__1; ++j) {
01290 i__2 = *m;
01291 for (i__ = j; i__ <= i__2; ++i__) {
01292 ++isub;
01293 if (isub > *lda) {
01294 isub = 1;
01295 ++jsub;
01296 }
01297 i__3 = isub + jsub * a_dim1;
01298 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01299 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01300 &iwork[1], sparse);
01301 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01302
01303 }
01304
01305 }
01306 }
01307
01308 } else if (ipack == 5) {
01309
01310 i__1 = *n;
01311 for (j = 1; j <= i__1; ++j) {
01312 i__2 = j;
01313 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01314 if (i__ < 1) {
01315 i__3 = j - i__ + 1 + (i__ + *n) * a_dim1;
01316 a[i__3].r = 0., a[i__3].i = 0.;
01317 } else {
01318 if (isym == 0) {
01319 i__3 = j - i__ + 1 + i__ * a_dim1;
01320 zlatm2_(&z__2, m, n, &i__, &j, kl, ku, &idist, &
01321 iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
01322 , &ipvtng, &iwork[1], sparse);
01323 d_cnjg(&z__1, &z__2);
01324 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01325 } else {
01326 i__3 = j - i__ + 1 + i__ * a_dim1;
01327 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &
01328 iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
01329 , &ipvtng, &iwork[1], sparse);
01330 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01331 }
01332 }
01333
01334 }
01335
01336 }
01337
01338 } else if (ipack == 6) {
01339
01340 i__1 = *n;
01341 for (j = 1; j <= i__1; ++j) {
01342 i__2 = j;
01343 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01344 i__3 = i__ - j + kuu + 1 + j * a_dim1;
01345 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[1],
01346 &d__[1], &igrade, &dl[1], &dr[1], &ipvtng, &iwork[
01347 1], sparse);
01348 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01349
01350 }
01351
01352 }
01353
01354 } else if (ipack == 7) {
01355
01356 if (isym != 1) {
01357 i__1 = *n;
01358 for (j = 1; j <= i__1; ++j) {
01359 i__2 = j;
01360 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01361 i__3 = i__ - j + kuu + 1 + j * a_dim1;
01362 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01363 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01364 &iwork[1], sparse);
01365 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01366 if (i__ < 1) {
01367 i__3 = j - i__ + 1 + kuu + (i__ + *n) * a_dim1;
01368 a[i__3].r = 0., a[i__3].i = 0.;
01369 }
01370 if (i__ >= 1 && i__ != j) {
01371 if (isym == 0) {
01372 i__3 = j - i__ + 1 + kuu + i__ * a_dim1;
01373 d_cnjg(&z__1, &a[i__ - j + kuu + 1 + j *
01374 a_dim1]);
01375 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01376 } else {
01377 i__3 = j - i__ + 1 + kuu + i__ * a_dim1;
01378 i__4 = i__ - j + kuu + 1 + j * a_dim1;
01379 a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
01380 }
01381 }
01382
01383 }
01384
01385 }
01386 } else if (isym == 1) {
01387 i__1 = *n;
01388 for (j = 1; j <= i__1; ++j) {
01389 i__2 = j + kll;
01390 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01391 i__3 = i__ - j + kuu + 1 + j * a_dim1;
01392 zlatm2_(&z__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01393 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01394 &iwork[1], sparse);
01395 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
01396
01397 }
01398
01399 }
01400 }
01401
01402 }
01403
01404 }
01405
01406
01407
01408 if (ipack == 0) {
01409 onorm = zlange_("M", m, n, &a[a_offset], lda, tempa);
01410 } else if (ipack == 1) {
01411 onorm = zlansy_("M", "U", n, &a[a_offset], lda, tempa);
01412 } else if (ipack == 2) {
01413 onorm = zlansy_("M", "L", n, &a[a_offset], lda, tempa);
01414 } else if (ipack == 3) {
01415 onorm = zlansp_("M", "U", n, &a[a_offset], tempa);
01416 } else if (ipack == 4) {
01417 onorm = zlansp_("M", "L", n, &a[a_offset], tempa);
01418 } else if (ipack == 5) {
01419 onorm = zlansb_("M", "L", n, &kll, &a[a_offset], lda, tempa);
01420 } else if (ipack == 6) {
01421 onorm = zlansb_("M", "U", n, &kuu, &a[a_offset], lda, tempa);
01422 } else if (ipack == 7) {
01423 onorm = zlangb_("M", n, &kll, &kuu, &a[a_offset], lda, tempa);
01424 }
01425
01426 if (*anorm >= 0.) {
01427
01428 if (*anorm > 0. && onorm == 0.) {
01429
01430
01431
01432 *info = 5;
01433 return 0;
01434
01435 } else if (*anorm > 1. && onorm < 1. || *anorm < 1. && onorm > 1.) {
01436
01437
01438
01439 if (ipack <= 2) {
01440 i__1 = *n;
01441 for (j = 1; j <= i__1; ++j) {
01442 d__1 = 1. / onorm;
01443 zdscal_(m, &d__1, &a[j * a_dim1 + 1], &c__1);
01444 zdscal_(m, anorm, &a[j * a_dim1 + 1], &c__1);
01445
01446 }
01447
01448 } else if (ipack == 3 || ipack == 4) {
01449
01450 i__1 = *n * (*n + 1) / 2;
01451 d__1 = 1. / onorm;
01452 zdscal_(&i__1, &d__1, &a[a_offset], &c__1);
01453 i__1 = *n * (*n + 1) / 2;
01454 zdscal_(&i__1, anorm, &a[a_offset], &c__1);
01455
01456 } else if (ipack >= 5) {
01457
01458 i__1 = *n;
01459 for (j = 1; j <= i__1; ++j) {
01460 i__2 = kll + kuu + 1;
01461 d__1 = 1. / onorm;
01462 zdscal_(&i__2, &d__1, &a[j * a_dim1 + 1], &c__1);
01463 i__2 = kll + kuu + 1;
01464 zdscal_(&i__2, anorm, &a[j * a_dim1 + 1], &c__1);
01465
01466 }
01467
01468 }
01469
01470 } else {
01471
01472
01473
01474 if (ipack <= 2) {
01475 i__1 = *n;
01476 for (j = 1; j <= i__1; ++j) {
01477 d__1 = *anorm / onorm;
01478 zdscal_(m, &d__1, &a[j * a_dim1 + 1], &c__1);
01479
01480 }
01481
01482 } else if (ipack == 3 || ipack == 4) {
01483
01484 i__1 = *n * (*n + 1) / 2;
01485 d__1 = *anorm / onorm;
01486 zdscal_(&i__1, &d__1, &a[a_offset], &c__1);
01487
01488 } else if (ipack >= 5) {
01489
01490 i__1 = *n;
01491 for (j = 1; j <= i__1; ++j) {
01492 i__2 = kll + kuu + 1;
01493 d__1 = *anorm / onorm;
01494 zdscal_(&i__2, &d__1, &a[j * a_dim1 + 1], &c__1);
01495
01496 }
01497 }
01498
01499 }
01500
01501 }
01502
01503
01504
01505 return 0;
01506 }