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 clatmr_(integer *m, integer *n, char *dist, integer *
00022 iseed, char *sym, complex *d__, integer *mode, real *cond, complex *
00023 dmax__, char *rsign, char *grade, complex *dl, integer *model, real *
00024 condl, complex *dr, integer *moder, real *condr, char *pivtng,
00025 integer *ipivot, integer *kl, integer *ku, real *sparse, real *anorm,
00026 char *pack, complex *a, integer *lda, integer *iwork, integer *info)
00027 {
00028
00029 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
00030 real r__1, r__2;
00031 complex q__1, q__2;
00032
00033
00034 double c_abs(complex *);
00035 void r_cnjg(complex *, complex *);
00036
00037
00038 integer i__, j, k, kll, kuu, isub, jsub;
00039 real temp;
00040 integer isym, ipack;
00041 extern logical lsame_(char *, char *);
00042 real tempa[1];
00043 complex ctemp;
00044 integer iisub, idist, jjsub, mnmin;
00045 logical dzero;
00046 integer mnsub;
00047 real onorm;
00048 integer mxsub, npvts;
00049 extern int clatm1_(integer *, real *, integer *, integer
00050 *, integer *, complex *, integer *, integer *);
00051 extern VOID clatm2_(complex *, integer *, integer *,
00052 integer *, integer *, integer *, integer *, integer *, integer *,
00053 complex *, integer *, complex *, complex *, integer *, integer *,
00054 real *), clatm3_(complex *, integer *, integer *, integer *,
00055 integer *, integer *, integer *, integer *, integer *, integer *,
00056 integer *, complex *, integer *, complex *, complex *, integer *,
00057 integer *, real *);
00058 extern doublereal clangb_(char *, integer *, integer *, integer *,
00059 complex *, integer *, real *);
00060 complex calpha;
00061 extern doublereal clange_(char *, integer *, integer *, complex *,
00062 integer *, real *);
00063 integer igrade;
00064 extern doublereal clansb_(char *, char *, integer *, integer *, complex *,
00065 integer *, real *);
00066 extern int csscal_(integer *, real *, complex *, integer
00067 *);
00068 logical fulbnd;
00069 extern int xerbla_(char *, integer *);
00070 logical badpvt;
00071 extern doublereal clansp_(char *, char *, integer *, complex *, real *), clansy_(char *, char *, integer *, complex *,
00072 integer *, real *);
00073 integer irsign, ipvtng;
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
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 --iseed;
00466 --d__;
00467 --dl;
00468 --dr;
00469 --ipivot;
00470 a_dim1 = *lda;
00471 a_offset = 1 + a_dim1;
00472 a -= a_offset;
00473 --iwork;
00474
00475
00476 *info = 0;
00477
00478
00479
00480 if (*m == 0 || *n == 0) {
00481 return 0;
00482 }
00483
00484
00485
00486 if (lsame_(dist, "U")) {
00487 idist = 1;
00488 } else if (lsame_(dist, "S")) {
00489 idist = 2;
00490 } else if (lsame_(dist, "N")) {
00491 idist = 3;
00492 } else if (lsame_(dist, "D")) {
00493 idist = 4;
00494 } else {
00495 idist = -1;
00496 }
00497
00498
00499
00500 if (lsame_(sym, "H")) {
00501 isym = 0;
00502 } else if (lsame_(sym, "N")) {
00503 isym = 1;
00504 } else if (lsame_(sym, "S")) {
00505 isym = 2;
00506 } else {
00507 isym = -1;
00508 }
00509
00510
00511
00512 if (lsame_(rsign, "F")) {
00513 irsign = 0;
00514 } else if (lsame_(rsign, "T")) {
00515 irsign = 1;
00516 } else {
00517 irsign = -1;
00518 }
00519
00520
00521
00522 if (lsame_(pivtng, "N")) {
00523 ipvtng = 0;
00524 } else if (lsame_(pivtng, " ")) {
00525 ipvtng = 0;
00526 } else if (lsame_(pivtng, "L")) {
00527 ipvtng = 1;
00528 npvts = *m;
00529 } else if (lsame_(pivtng, "R")) {
00530 ipvtng = 2;
00531 npvts = *n;
00532 } else if (lsame_(pivtng, "B")) {
00533 ipvtng = 3;
00534 npvts = min(*n,*m);
00535 } else if (lsame_(pivtng, "F")) {
00536 ipvtng = 3;
00537 npvts = min(*n,*m);
00538 } else {
00539 ipvtng = -1;
00540 }
00541
00542
00543
00544 if (lsame_(grade, "N")) {
00545 igrade = 0;
00546 } else if (lsame_(grade, "L")) {
00547 igrade = 1;
00548 } else if (lsame_(grade, "R")) {
00549 igrade = 2;
00550 } else if (lsame_(grade, "B")) {
00551 igrade = 3;
00552 } else if (lsame_(grade, "E")) {
00553 igrade = 4;
00554 } else if (lsame_(grade, "H")) {
00555 igrade = 5;
00556 } else if (lsame_(grade, "S")) {
00557 igrade = 6;
00558 } else {
00559 igrade = -1;
00560 }
00561
00562
00563
00564 if (lsame_(pack, "N")) {
00565 ipack = 0;
00566 } else if (lsame_(pack, "U")) {
00567 ipack = 1;
00568 } else if (lsame_(pack, "L")) {
00569 ipack = 2;
00570 } else if (lsame_(pack, "C")) {
00571 ipack = 3;
00572 } else if (lsame_(pack, "R")) {
00573 ipack = 4;
00574 } else if (lsame_(pack, "B")) {
00575 ipack = 5;
00576 } else if (lsame_(pack, "Q")) {
00577 ipack = 6;
00578 } else if (lsame_(pack, "Z")) {
00579 ipack = 7;
00580 } else {
00581 ipack = -1;
00582 }
00583
00584
00585
00586 mnmin = min(*m,*n);
00587
00588 i__1 = *kl, i__2 = *m - 1;
00589 kll = min(i__1,i__2);
00590
00591 i__1 = *ku, i__2 = *n - 1;
00592 kuu = min(i__1,i__2);
00593
00594
00595
00596 dzero = FALSE_;
00597 if (igrade == 4 && *model == 0) {
00598 i__1 = *m;
00599 for (i__ = 1; i__ <= i__1; ++i__) {
00600 i__2 = i__;
00601 if (dl[i__2].r == 0.f && dl[i__2].i == 0.f) {
00602 dzero = TRUE_;
00603 }
00604
00605 }
00606 }
00607
00608
00609
00610 badpvt = FALSE_;
00611 if (ipvtng > 0) {
00612 i__1 = npvts;
00613 for (j = 1; j <= i__1; ++j) {
00614 if (ipivot[j] <= 0 || ipivot[j] > npvts) {
00615 badpvt = TRUE_;
00616 }
00617
00618 }
00619 }
00620
00621
00622
00623 if (*m < 0) {
00624 *info = -1;
00625 } else if (*m != *n && (isym == 0 || isym == 2)) {
00626 *info = -1;
00627 } else if (*n < 0) {
00628 *info = -2;
00629 } else if (idist == -1) {
00630 *info = -3;
00631 } else if (isym == -1) {
00632 *info = -5;
00633 } else if (*mode < -6 || *mode > 6) {
00634 *info = -7;
00635 } else if (*mode != -6 && *mode != 0 && *mode != 6 && *cond < 1.f) {
00636 *info = -8;
00637 } else if (*mode != -6 && *mode != 0 && *mode != 6 && irsign == -1) {
00638 *info = -10;
00639 } else if (igrade == -1 || igrade == 4 && *m != *n || (igrade == 1 ||
00640 igrade == 2 || igrade == 3 || igrade == 4 || igrade == 6) && isym
00641 == 0 || (igrade == 1 || igrade == 2 || igrade == 3 || igrade == 4
00642 || igrade == 5) && isym == 2) {
00643 *info = -11;
00644 } else if (igrade == 4 && dzero) {
00645 *info = -12;
00646 } else if ((igrade == 1 || igrade == 3 || igrade == 4 || igrade == 5 ||
00647 igrade == 6) && (*model < -6 || *model > 6)) {
00648 *info = -13;
00649 } else if ((igrade == 1 || igrade == 3 || igrade == 4 || igrade == 5 ||
00650 igrade == 6) && (*model != -6 && *model != 0 && *model != 6) && *
00651 condl < 1.f) {
00652 *info = -14;
00653 } else if ((igrade == 2 || igrade == 3) && (*moder < -6 || *moder > 6)) {
00654 *info = -16;
00655 } else if ((igrade == 2 || igrade == 3) && (*moder != -6 && *moder != 0 &&
00656 *moder != 6) && *condr < 1.f) {
00657 *info = -17;
00658 } else if (ipvtng == -1 || ipvtng == 3 && *m != *n || (ipvtng == 1 ||
00659 ipvtng == 2) && (isym == 0 || isym == 2)) {
00660 *info = -18;
00661 } else if (ipvtng != 0 && badpvt) {
00662 *info = -19;
00663 } else if (*kl < 0) {
00664 *info = -20;
00665 } else if (*ku < 0 || (isym == 0 || isym == 2) && *kl != *ku) {
00666 *info = -21;
00667 } else if (*sparse < 0.f || *sparse > 1.f) {
00668 *info = -22;
00669 } else if (ipack == -1 || (ipack == 1 || ipack == 2 || ipack == 5 ||
00670 ipack == 6) && isym == 1 || ipack == 3 && isym == 1 && (*kl != 0
00671 || *m != *n) || ipack == 4 && isym == 1 && (*ku != 0 || *m != *n))
00672 {
00673 *info = -24;
00674 } else if ((ipack == 0 || ipack == 1 || ipack == 2) && *lda < max(1,*m) ||
00675 (ipack == 3 || ipack == 4) && *lda < 1 || (ipack == 5 || ipack ==
00676 6) && *lda < kuu + 1 || ipack == 7 && *lda < kll + kuu + 1) {
00677 *info = -26;
00678 }
00679
00680 if (*info != 0) {
00681 i__1 = -(*info);
00682 xerbla_("CLATMR", &i__1);
00683 return 0;
00684 }
00685
00686
00687
00688 fulbnd = FALSE_;
00689 if (kuu == *n - 1 && kll == *m - 1) {
00690 fulbnd = TRUE_;
00691 }
00692
00693
00694
00695 for (i__ = 1; i__ <= 4; ++i__) {
00696 iseed[i__] = (i__1 = iseed[i__], abs(i__1)) % 4096;
00697
00698 }
00699
00700 iseed[4] = (iseed[4] / 2 << 1) + 1;
00701
00702
00703
00704
00705
00706 clatm1_(mode, cond, &irsign, &idist, &iseed[1], &d__[1], &mnmin, info);
00707 if (*info != 0) {
00708 *info = 1;
00709 return 0;
00710 }
00711 if (*mode != 0 && *mode != -6 && *mode != 6) {
00712
00713
00714
00715 temp = c_abs(&d__[1]);
00716 i__1 = mnmin;
00717 for (i__ = 2; i__ <= i__1; ++i__) {
00718
00719 r__1 = temp, r__2 = c_abs(&d__[i__]);
00720 temp = dmax(r__1,r__2);
00721
00722 }
00723 if (temp == 0.f && (dmax__->r != 0.f || dmax__->i != 0.f)) {
00724 *info = 2;
00725 return 0;
00726 }
00727 if (temp != 0.f) {
00728 q__1.r = dmax__->r / temp, q__1.i = dmax__->i / temp;
00729 calpha.r = q__1.r, calpha.i = q__1.i;
00730 } else {
00731 calpha.r = 1.f, calpha.i = 0.f;
00732 }
00733 i__1 = mnmin;
00734 for (i__ = 1; i__ <= i__1; ++i__) {
00735 i__2 = i__;
00736 i__3 = i__;
00737 q__1.r = calpha.r * d__[i__3].r - calpha.i * d__[i__3].i, q__1.i =
00738 calpha.r * d__[i__3].i + calpha.i * d__[i__3].r;
00739 d__[i__2].r = q__1.r, d__[i__2].i = q__1.i;
00740
00741 }
00742
00743 }
00744
00745
00746
00747 if (isym == 0) {
00748 i__1 = mnmin;
00749 for (i__ = 1; i__ <= i__1; ++i__) {
00750 i__2 = i__;
00751 i__3 = i__;
00752 r__1 = d__[i__3].r;
00753 d__[i__2].r = r__1, d__[i__2].i = 0.f;
00754
00755 }
00756 }
00757
00758
00759
00760 if (igrade == 1 || igrade == 3 || igrade == 4 || igrade == 5 || igrade ==
00761 6) {
00762 clatm1_(model, condl, &c__0, &idist, &iseed[1], &dl[1], m, info);
00763 if (*info != 0) {
00764 *info = 3;
00765 return 0;
00766 }
00767 }
00768
00769
00770
00771 if (igrade == 2 || igrade == 3) {
00772 clatm1_(moder, condr, &c__0, &idist, &iseed[1], &dr[1], n, info);
00773 if (*info != 0) {
00774 *info = 4;
00775 return 0;
00776 }
00777 }
00778
00779
00780
00781 if (ipvtng > 0) {
00782 i__1 = npvts;
00783 for (i__ = 1; i__ <= i__1; ++i__) {
00784 iwork[i__] = i__;
00785
00786 }
00787 if (fulbnd) {
00788 i__1 = npvts;
00789 for (i__ = 1; i__ <= i__1; ++i__) {
00790 k = ipivot[i__];
00791 j = iwork[i__];
00792 iwork[i__] = iwork[k];
00793 iwork[k] = j;
00794
00795 }
00796 } else {
00797 for (i__ = npvts; i__ >= 1; --i__) {
00798 k = ipivot[i__];
00799 j = iwork[i__];
00800 iwork[i__] = iwork[k];
00801 iwork[k] = j;
00802
00803 }
00804 }
00805 }
00806
00807
00808
00809
00810
00811
00812 if (fulbnd) {
00813
00814
00815
00816
00817 if (ipack == 0) {
00818 if (isym == 0) {
00819 i__1 = *n;
00820 for (j = 1; j <= i__1; ++j) {
00821 i__2 = j;
00822 for (i__ = 1; i__ <= i__2; ++i__) {
00823 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00824 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
00825 dr[1], &ipvtng, &iwork[1], sparse);
00826 ctemp.r = q__1.r, ctemp.i = q__1.i;
00827 i__3 = isub + jsub * a_dim1;
00828 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00829 i__3 = jsub + isub * a_dim1;
00830 r_cnjg(&q__1, &ctemp);
00831 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00832
00833 }
00834
00835 }
00836 } else if (isym == 1) {
00837 i__1 = *n;
00838 for (j = 1; j <= i__1; ++j) {
00839 i__2 = *m;
00840 for (i__ = 1; i__ <= i__2; ++i__) {
00841 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00842 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
00843 dr[1], &ipvtng, &iwork[1], sparse);
00844 ctemp.r = q__1.r, ctemp.i = q__1.i;
00845 i__3 = isub + jsub * a_dim1;
00846 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00847
00848 }
00849
00850 }
00851 } else if (isym == 2) {
00852 i__1 = *n;
00853 for (j = 1; j <= i__1; ++j) {
00854 i__2 = j;
00855 for (i__ = 1; i__ <= i__2; ++i__) {
00856 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00857 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
00858 dr[1], &ipvtng, &iwork[1], sparse);
00859 ctemp.r = q__1.r, ctemp.i = q__1.i;
00860 i__3 = isub + jsub * a_dim1;
00861 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00862 i__3 = jsub + isub * a_dim1;
00863 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00864
00865 }
00866
00867 }
00868 }
00869
00870 } else if (ipack == 1) {
00871
00872 i__1 = *n;
00873 for (j = 1; j <= i__1; ++j) {
00874 i__2 = j;
00875 for (i__ = 1; i__ <= i__2; ++i__) {
00876 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00877 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00878 , &ipvtng, &iwork[1], sparse);
00879 ctemp.r = q__1.r, ctemp.i = q__1.i;
00880 mnsub = min(isub,jsub);
00881 mxsub = max(isub,jsub);
00882 if (mxsub == isub && isym == 0) {
00883 i__3 = mnsub + mxsub * a_dim1;
00884 r_cnjg(&q__1, &ctemp);
00885 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00886 } else {
00887 i__3 = mnsub + mxsub * a_dim1;
00888 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00889 }
00890 if (mnsub != mxsub) {
00891 i__3 = mxsub + mnsub * a_dim1;
00892 a[i__3].r = 0.f, a[i__3].i = 0.f;
00893 }
00894
00895 }
00896
00897 }
00898
00899 } else if (ipack == 2) {
00900
00901 i__1 = *n;
00902 for (j = 1; j <= i__1; ++j) {
00903 i__2 = j;
00904 for (i__ = 1; i__ <= i__2; ++i__) {
00905 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00906 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00907 , &ipvtng, &iwork[1], sparse);
00908 ctemp.r = q__1.r, ctemp.i = q__1.i;
00909 mnsub = min(isub,jsub);
00910 mxsub = max(isub,jsub);
00911 if (mxsub == jsub && isym == 0) {
00912 i__3 = mxsub + mnsub * a_dim1;
00913 r_cnjg(&q__1, &ctemp);
00914 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00915 } else {
00916 i__3 = mxsub + mnsub * a_dim1;
00917 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00918 }
00919 if (mnsub != mxsub) {
00920 i__3 = mnsub + mxsub * a_dim1;
00921 a[i__3].r = 0.f, a[i__3].i = 0.f;
00922 }
00923
00924 }
00925
00926 }
00927
00928 } else if (ipack == 3) {
00929
00930 i__1 = *n;
00931 for (j = 1; j <= i__1; ++j) {
00932 i__2 = j;
00933 for (i__ = 1; i__ <= i__2; ++i__) {
00934 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00935 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00936 , &ipvtng, &iwork[1], sparse);
00937 ctemp.r = q__1.r, ctemp.i = q__1.i;
00938
00939
00940
00941
00942 mnsub = min(isub,jsub);
00943 mxsub = max(isub,jsub);
00944 k = mxsub * (mxsub - 1) / 2 + mnsub;
00945
00946
00947
00948 jjsub = (k - 1) / *lda + 1;
00949 iisub = k - *lda * (jjsub - 1);
00950
00951 if (mxsub == isub && isym == 0) {
00952 i__3 = iisub + jjsub * a_dim1;
00953 r_cnjg(&q__1, &ctemp);
00954 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00955 } else {
00956 i__3 = iisub + jjsub * a_dim1;
00957 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00958 }
00959
00960 }
00961
00962 }
00963
00964 } else if (ipack == 4) {
00965
00966 i__1 = *n;
00967 for (j = 1; j <= i__1; ++j) {
00968 i__2 = j;
00969 for (i__ = 1; i__ <= i__2; ++i__) {
00970 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
00971 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
00972 , &ipvtng, &iwork[1], sparse);
00973 ctemp.r = q__1.r, ctemp.i = q__1.i;
00974
00975
00976
00977 mnsub = min(isub,jsub);
00978 mxsub = max(isub,jsub);
00979 if (mnsub == 1) {
00980 k = mxsub;
00981 } else {
00982 k = *n * (*n + 1) / 2 - (*n - mnsub + 1) * (*n -
00983 mnsub + 2) / 2 + mxsub - mnsub + 1;
00984 }
00985
00986
00987
00988 jjsub = (k - 1) / *lda + 1;
00989 iisub = k - *lda * (jjsub - 1);
00990
00991 if (mxsub == jsub && isym == 0) {
00992 i__3 = iisub + jjsub * a_dim1;
00993 r_cnjg(&q__1, &ctemp);
00994 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00995 } else {
00996 i__3 = iisub + jjsub * a_dim1;
00997 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
00998 }
00999
01000 }
01001
01002 }
01003
01004 } else if (ipack == 5) {
01005
01006 i__1 = *n;
01007 for (j = 1; j <= i__1; ++j) {
01008 i__2 = j;
01009 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01010 if (i__ < 1) {
01011 i__3 = j - i__ + 1 + (i__ + *n) * a_dim1;
01012 a[i__3].r = 0.f, a[i__3].i = 0.f;
01013 } else {
01014 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01015 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
01016 dr[1], &ipvtng, &iwork[1], sparse);
01017 ctemp.r = q__1.r, ctemp.i = q__1.i;
01018 mnsub = min(isub,jsub);
01019 mxsub = max(isub,jsub);
01020 if (mxsub == jsub && isym == 0) {
01021 i__3 = mxsub - mnsub + 1 + mnsub * a_dim1;
01022 r_cnjg(&q__1, &ctemp);
01023 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01024 } else {
01025 i__3 = mxsub - mnsub + 1 + mnsub * a_dim1;
01026 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01027 }
01028 }
01029
01030 }
01031
01032 }
01033
01034 } else if (ipack == 6) {
01035
01036 i__1 = *n;
01037 for (j = 1; j <= i__1; ++j) {
01038 i__2 = j;
01039 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01040 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01041 idist, &iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
01042 , &ipvtng, &iwork[1], sparse);
01043 ctemp.r = q__1.r, ctemp.i = q__1.i;
01044 mnsub = min(isub,jsub);
01045 mxsub = max(isub,jsub);
01046 if (mxsub == isub && isym == 0) {
01047 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01048 r_cnjg(&q__1, &ctemp);
01049 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01050 } else {
01051 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01052 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01053 }
01054
01055 }
01056
01057 }
01058
01059 } else if (ipack == 7) {
01060
01061 if (isym != 1) {
01062 i__1 = *n;
01063 for (j = 1; j <= i__1; ++j) {
01064 i__2 = j;
01065 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01066 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01067 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
01068 dr[1], &ipvtng, &iwork[1], sparse);
01069 ctemp.r = q__1.r, ctemp.i = q__1.i;
01070 mnsub = min(isub,jsub);
01071 mxsub = max(isub,jsub);
01072 if (i__ < 1) {
01073 i__3 = j - i__ + 1 + kuu + (i__ + *n) * a_dim1;
01074 a[i__3].r = 0.f, a[i__3].i = 0.f;
01075 }
01076 if (mxsub == isub && isym == 0) {
01077 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01078 r_cnjg(&q__1, &ctemp);
01079 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01080 } else {
01081 i__3 = mnsub - mxsub + kuu + 1 + mxsub * a_dim1;
01082 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01083 }
01084 if (i__ >= 1 && mnsub != mxsub) {
01085 if (mnsub == isub && isym == 0) {
01086 i__3 = mxsub - mnsub + 1 + kuu + mnsub *
01087 a_dim1;
01088 r_cnjg(&q__1, &ctemp);
01089 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01090 } else {
01091 i__3 = mxsub - mnsub + 1 + kuu + mnsub *
01092 a_dim1;
01093 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01094 }
01095 }
01096
01097 }
01098
01099 }
01100 } else if (isym == 1) {
01101 i__1 = *n;
01102 for (j = 1; j <= i__1; ++j) {
01103 i__2 = j + kll;
01104 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01105 clatm3_(&q__1, m, n, &i__, &j, &isub, &jsub, kl, ku, &
01106 idist, &iseed[1], &d__[1], &igrade, &dl[1], &
01107 dr[1], &ipvtng, &iwork[1], sparse);
01108 ctemp.r = q__1.r, ctemp.i = q__1.i;
01109 i__3 = isub - jsub + kuu + 1 + jsub * a_dim1;
01110 a[i__3].r = ctemp.r, a[i__3].i = ctemp.i;
01111
01112 }
01113
01114 }
01115 }
01116
01117 }
01118
01119 } else {
01120
01121
01122
01123 if (ipack == 0) {
01124 if (isym == 0) {
01125 i__1 = *n;
01126 for (j = 1; j <= i__1; ++j) {
01127 i__2 = j;
01128 for (i__ = 1; i__ <= i__2; ++i__) {
01129 i__3 = i__ + j * a_dim1;
01130 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01131 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01132 &iwork[1], sparse);
01133 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01134 i__3 = j + i__ * a_dim1;
01135 r_cnjg(&q__1, &a[i__ + j * a_dim1]);
01136 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01137
01138 }
01139
01140 }
01141 } else if (isym == 1) {
01142 i__1 = *n;
01143 for (j = 1; j <= i__1; ++j) {
01144 i__2 = *m;
01145 for (i__ = 1; i__ <= i__2; ++i__) {
01146 i__3 = i__ + j * a_dim1;
01147 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01148 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01149 &iwork[1], sparse);
01150 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01151
01152 }
01153
01154 }
01155 } else if (isym == 2) {
01156 i__1 = *n;
01157 for (j = 1; j <= i__1; ++j) {
01158 i__2 = j;
01159 for (i__ = 1; i__ <= i__2; ++i__) {
01160 i__3 = i__ + j * a_dim1;
01161 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01162 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01163 &iwork[1], sparse);
01164 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01165 i__3 = j + i__ * a_dim1;
01166 i__4 = i__ + j * a_dim1;
01167 a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
01168
01169 }
01170
01171 }
01172 }
01173
01174 } else if (ipack == 1) {
01175
01176 i__1 = *n;
01177 for (j = 1; j <= i__1; ++j) {
01178 i__2 = j;
01179 for (i__ = 1; i__ <= i__2; ++i__) {
01180 i__3 = i__ + j * a_dim1;
01181 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[1],
01182 &d__[1], &igrade, &dl[1], &dr[1], &ipvtng, &iwork[
01183 1], sparse);
01184 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01185 if (i__ != j) {
01186 i__3 = j + i__ * a_dim1;
01187 a[i__3].r = 0.f, a[i__3].i = 0.f;
01188 }
01189
01190 }
01191
01192 }
01193
01194 } else if (ipack == 2) {
01195
01196 i__1 = *n;
01197 for (j = 1; j <= i__1; ++j) {
01198 i__2 = j;
01199 for (i__ = 1; i__ <= i__2; ++i__) {
01200 if (isym == 0) {
01201 i__3 = j + i__ * a_dim1;
01202 clatm2_(&q__2, m, n, &i__, &j, kl, ku, &idist, &iseed[
01203 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01204 &iwork[1], sparse);
01205 r_cnjg(&q__1, &q__2);
01206 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01207 } else {
01208 i__3 = j + i__ * a_dim1;
01209 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01210 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01211 &iwork[1], sparse);
01212 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01213 }
01214 if (i__ != j) {
01215 i__3 = i__ + j * a_dim1;
01216 a[i__3].r = 0.f, a[i__3].i = 0.f;
01217 }
01218
01219 }
01220
01221 }
01222
01223 } else if (ipack == 3) {
01224
01225 isub = 0;
01226 jsub = 1;
01227 i__1 = *n;
01228 for (j = 1; j <= i__1; ++j) {
01229 i__2 = j;
01230 for (i__ = 1; i__ <= i__2; ++i__) {
01231 ++isub;
01232 if (isub > *lda) {
01233 isub = 1;
01234 ++jsub;
01235 }
01236 i__3 = isub + jsub * a_dim1;
01237 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[1],
01238 &d__[1], &igrade, &dl[1], &dr[1], &ipvtng, &iwork[
01239 1], sparse);
01240 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01241
01242 }
01243
01244 }
01245
01246 } else if (ipack == 4) {
01247
01248 if (isym == 0 || isym == 2) {
01249 i__1 = *n;
01250 for (j = 1; j <= i__1; ++j) {
01251 i__2 = j;
01252 for (i__ = 1; i__ <= i__2; ++i__) {
01253
01254
01255
01256 if (i__ == 1) {
01257 k = j;
01258 } else {
01259 k = *n * (*n + 1) / 2 - (*n - i__ + 1) * (*n -
01260 i__ + 2) / 2 + j - i__ + 1;
01261 }
01262
01263
01264
01265 jsub = (k - 1) / *lda + 1;
01266 isub = k - *lda * (jsub - 1);
01267
01268 i__3 = isub + jsub * a_dim1;
01269 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01270 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01271 &iwork[1], sparse);
01272 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01273 if (isym == 0) {
01274 i__3 = isub + jsub * a_dim1;
01275 r_cnjg(&q__1, &a[isub + jsub * a_dim1]);
01276 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01277 }
01278
01279 }
01280
01281 }
01282 } else {
01283 isub = 0;
01284 jsub = 1;
01285 i__1 = *n;
01286 for (j = 1; j <= i__1; ++j) {
01287 i__2 = *m;
01288 for (i__ = j; i__ <= i__2; ++i__) {
01289 ++isub;
01290 if (isub > *lda) {
01291 isub = 1;
01292 ++jsub;
01293 }
01294 i__3 = isub + jsub * a_dim1;
01295 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01296 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01297 &iwork[1], sparse);
01298 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01299
01300 }
01301
01302 }
01303 }
01304
01305 } else if (ipack == 5) {
01306
01307 i__1 = *n;
01308 for (j = 1; j <= i__1; ++j) {
01309 i__2 = j;
01310 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01311 if (i__ < 1) {
01312 i__3 = j - i__ + 1 + (i__ + *n) * a_dim1;
01313 a[i__3].r = 0.f, a[i__3].i = 0.f;
01314 } else {
01315 if (isym == 0) {
01316 i__3 = j - i__ + 1 + i__ * a_dim1;
01317 clatm2_(&q__2, m, n, &i__, &j, kl, ku, &idist, &
01318 iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
01319 , &ipvtng, &iwork[1], sparse);
01320 r_cnjg(&q__1, &q__2);
01321 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01322 } else {
01323 i__3 = j - i__ + 1 + i__ * a_dim1;
01324 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &
01325 iseed[1], &d__[1], &igrade, &dl[1], &dr[1]
01326 , &ipvtng, &iwork[1], sparse);
01327 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01328 }
01329 }
01330
01331 }
01332
01333 }
01334
01335 } else if (ipack == 6) {
01336
01337 i__1 = *n;
01338 for (j = 1; j <= i__1; ++j) {
01339 i__2 = j;
01340 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01341 i__3 = i__ - j + kuu + 1 + j * a_dim1;
01342 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[1],
01343 &d__[1], &igrade, &dl[1], &dr[1], &ipvtng, &iwork[
01344 1], sparse);
01345 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01346
01347 }
01348
01349 }
01350
01351 } else if (ipack == 7) {
01352
01353 if (isym != 1) {
01354 i__1 = *n;
01355 for (j = 1; j <= i__1; ++j) {
01356 i__2 = j;
01357 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01358 i__3 = i__ - j + kuu + 1 + j * a_dim1;
01359 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01360 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01361 &iwork[1], sparse);
01362 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01363 if (i__ < 1) {
01364 i__3 = j - i__ + 1 + kuu + (i__ + *n) * a_dim1;
01365 a[i__3].r = 0.f, a[i__3].i = 0.f;
01366 }
01367 if (i__ >= 1 && i__ != j) {
01368 if (isym == 0) {
01369 i__3 = j - i__ + 1 + kuu + i__ * a_dim1;
01370 r_cnjg(&q__1, &a[i__ - j + kuu + 1 + j *
01371 a_dim1]);
01372 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01373 } else {
01374 i__3 = j - i__ + 1 + kuu + i__ * a_dim1;
01375 i__4 = i__ - j + kuu + 1 + j * a_dim1;
01376 a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
01377 }
01378 }
01379
01380 }
01381
01382 }
01383 } else if (isym == 1) {
01384 i__1 = *n;
01385 for (j = 1; j <= i__1; ++j) {
01386 i__2 = j + kll;
01387 for (i__ = j - kuu; i__ <= i__2; ++i__) {
01388 i__3 = i__ - j + kuu + 1 + j * a_dim1;
01389 clatm2_(&q__1, m, n, &i__, &j, kl, ku, &idist, &iseed[
01390 1], &d__[1], &igrade, &dl[1], &dr[1], &ipvtng,
01391 &iwork[1], sparse);
01392 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
01393
01394 }
01395
01396 }
01397 }
01398
01399 }
01400
01401 }
01402
01403
01404
01405 if (ipack == 0) {
01406 onorm = clange_("M", m, n, &a[a_offset], lda, tempa);
01407 } else if (ipack == 1) {
01408 onorm = clansy_("M", "U", n, &a[a_offset], lda, tempa);
01409 } else if (ipack == 2) {
01410 onorm = clansy_("M", "L", n, &a[a_offset], lda, tempa);
01411 } else if (ipack == 3) {
01412 onorm = clansp_("M", "U", n, &a[a_offset], tempa);
01413 } else if (ipack == 4) {
01414 onorm = clansp_("M", "L", n, &a[a_offset], tempa);
01415 } else if (ipack == 5) {
01416 onorm = clansb_("M", "L", n, &kll, &a[a_offset], lda, tempa);
01417 } else if (ipack == 6) {
01418 onorm = clansb_("M", "U", n, &kuu, &a[a_offset], lda, tempa);
01419 } else if (ipack == 7) {
01420 onorm = clangb_("M", n, &kll, &kuu, &a[a_offset], lda, tempa);
01421 }
01422
01423 if (*anorm >= 0.f) {
01424
01425 if (*anorm > 0.f && onorm == 0.f) {
01426
01427
01428
01429 *info = 5;
01430 return 0;
01431
01432 } else if (*anorm > 1.f && onorm < 1.f || *anorm < 1.f && onorm > 1.f)
01433 {
01434
01435
01436
01437 if (ipack <= 2) {
01438 i__1 = *n;
01439 for (j = 1; j <= i__1; ++j) {
01440 r__1 = 1.f / onorm;
01441 csscal_(m, &r__1, &a[j * a_dim1 + 1], &c__1);
01442 csscal_(m, anorm, &a[j * a_dim1 + 1], &c__1);
01443
01444 }
01445
01446 } else if (ipack == 3 || ipack == 4) {
01447
01448 i__1 = *n * (*n + 1) / 2;
01449 r__1 = 1.f / onorm;
01450 csscal_(&i__1, &r__1, &a[a_offset], &c__1);
01451 i__1 = *n * (*n + 1) / 2;
01452 csscal_(&i__1, anorm, &a[a_offset], &c__1);
01453
01454 } else if (ipack >= 5) {
01455
01456 i__1 = *n;
01457 for (j = 1; j <= i__1; ++j) {
01458 i__2 = kll + kuu + 1;
01459 r__1 = 1.f / onorm;
01460 csscal_(&i__2, &r__1, &a[j * a_dim1 + 1], &c__1);
01461 i__2 = kll + kuu + 1;
01462 csscal_(&i__2, anorm, &a[j * a_dim1 + 1], &c__1);
01463
01464 }
01465
01466 }
01467
01468 } else {
01469
01470
01471
01472 if (ipack <= 2) {
01473 i__1 = *n;
01474 for (j = 1; j <= i__1; ++j) {
01475 r__1 = *anorm / onorm;
01476 csscal_(m, &r__1, &a[j * a_dim1 + 1], &c__1);
01477
01478 }
01479
01480 } else if (ipack == 3 || ipack == 4) {
01481
01482 i__1 = *n * (*n + 1) / 2;
01483 r__1 = *anorm / onorm;
01484 csscal_(&i__1, &r__1, &a[a_offset], &c__1);
01485
01486 } else if (ipack >= 5) {
01487
01488 i__1 = *n;
01489 for (j = 1; j <= i__1; ++j) {
01490 i__2 = kll + kuu + 1;
01491 r__1 = *anorm / onorm;
01492 csscal_(&i__2, &r__1, &a[j * a_dim1 + 1], &c__1);
01493
01494 }
01495 }
01496
01497 }
01498
01499 }
01500
01501
01502
01503 return 0;
01504 }