zlatms.c
Go to the documentation of this file.
00001 /* zlatms.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static doublecomplex c_b1 = {0.,0.};
00019 static integer c__1 = 1;
00020 static integer c__5 = 5;
00021 static logical c_true = TRUE_;
00022 static logical c_false = FALSE_;
00023 
00024 /* Subroutine */ int zlatms_(integer *m, integer *n, char *dist, integer *
00025         iseed, char *sym, doublereal *d__, integer *mode, doublereal *cond, 
00026         doublereal *dmax__, integer *kl, integer *ku, char *pack, 
00027         doublecomplex *a, integer *lda, doublecomplex *work, integer *info)
00028 {
00029     /* System generated locals */
00030     integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
00031     doublereal d__1, d__2, d__3;
00032     doublecomplex z__1, z__2, z__3;
00033     logical L__1;
00034 
00035     /* Builtin functions */
00036     double cos(doublereal), sin(doublereal);
00037     void d_cnjg(doublecomplex *, doublecomplex *);
00038 
00039     /* Local variables */
00040     doublecomplex c__;
00041     integer i__, j, k;
00042     doublecomplex s;
00043     integer ic, jc, nc, il;
00044     doublecomplex ct;
00045     integer ir, jr, mr;
00046     doublecomplex st;
00047     integer ir1, ir2, jch, llb, jkl, jku, uub, ilda, icol;
00048     doublereal temp;
00049     integer irow, isym;
00050     logical zsym;
00051     doublereal alpha, angle;
00052     integer ipack;
00053     doublereal realc;
00054     integer ioffg;
00055     extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *, 
00056             integer *);
00057     extern logical lsame_(char *, char *);
00058     integer iinfo;
00059     doublecomplex ctemp;
00060     integer idist, mnmin, iskew;
00061     doublecomplex extra, dummy;
00062     extern /* Subroutine */ int dlatm1_(integer *, doublereal *, integer *, 
00063             integer *, integer *, doublereal *, integer *, integer *);
00064     integer iendch, ipackg, minlda;
00065     extern doublereal dlarnd_(integer *, integer *);
00066     extern /* Subroutine */ int zlagge_(integer *, integer *, integer *, 
00067             integer *, doublereal *, doublecomplex *, integer *, integer *, 
00068             doublecomplex *, integer *), zlaghe_(integer *, integer *, 
00069             doublereal *, doublecomplex *, integer *, integer *, 
00070             doublecomplex *, integer *), xerbla_(char *, integer *);
00071     logical iltemp, givens;
00072     integer ioffst, irsign;
00073     extern /* Double Complex */ VOID zlarnd_(doublecomplex *, integer *, 
00074             integer *);
00075     extern /* Subroutine */ int zlaset_(char *, integer *, integer *, 
00076             doublecomplex *, doublecomplex *, doublecomplex *, integer *), zlartg_(doublecomplex *, doublecomplex *, doublereal *, 
00077             doublecomplex *, doublecomplex *);
00078     logical ilextr;
00079     extern /* Subroutine */ int zlagsy_(integer *, integer *, doublereal *, 
00080             doublecomplex *, integer *, integer *, doublecomplex *, integer *)
00081             ;
00082     logical topdwn;
00083     integer isympk;
00084     extern /* Subroutine */ int zlarot_(logical *, logical *, logical *, 
00085             integer *, doublecomplex *, doublecomplex *, doublecomplex *, 
00086             integer *, doublecomplex *, doublecomplex *);
00087 
00088 
00089 /*  -- LAPACK test routine (version 3.1) -- */
00090 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00091 /*     November 2006 */
00092 
00093 /*     .. Scalar Arguments .. */
00094 /*     .. */
00095 /*     .. Array Arguments .. */
00096 /*     .. */
00097 
00098 /*  Purpose */
00099 /*  ======= */
00100 
00101 /*     ZLATMS generates random matrices with specified singular values */
00102 /*     (or hermitian with specified eigenvalues) */
00103 /*     for testing LAPACK programs. */
00104 
00105 /*     ZLATMS operates by applying the following sequence of */
00106 /*     operations: */
00107 
00108 /*       Set the diagonal to D, where D may be input or */
00109 /*          computed according to MODE, COND, DMAX, and SYM */
00110 /*          as described below. */
00111 
00112 /*       Generate a matrix with the appropriate band structure, by one */
00113 /*          of two methods: */
00114 
00115 /*       Method A: */
00116 /*           Generate a dense M x N matrix by multiplying D on the left */
00117 /*               and the right by random unitary matrices, then: */
00118 
00119 /*           Reduce the bandwidth according to KL and KU, using */
00120 /*               Householder transformations. */
00121 
00122 /*       Method B: */
00123 /*           Convert the bandwidth-0 (i.e., diagonal) matrix to a */
00124 /*               bandwidth-1 matrix using Givens rotations, "chasing" */
00125 /*               out-of-band elements back, much as in QR; then convert */
00126 /*               the bandwidth-1 to a bandwidth-2 matrix, etc.  Note */
00127 /*               that for reasonably small bandwidths (relative to M and */
00128 /*               N) this requires less storage, as a dense matrix is not */
00129 /*               generated.  Also, for hermitian or symmetric matrices, */
00130 /*               only one triangle is generated. */
00131 
00132 /*       Method A is chosen if the bandwidth is a large fraction of the */
00133 /*           order of the matrix, and LDA is at least M (so a dense */
00134 /*           matrix can be stored.)  Method B is chosen if the bandwidth */
00135 /*           is small (< 1/2 N for hermitian or symmetric, < .3 N+M for */
00136 /*           non-symmetric), or LDA is less than M and not less than the */
00137 /*           bandwidth. */
00138 
00139 /*       Pack the matrix if desired. Options specified by PACK are: */
00140 /*          no packing */
00141 /*          zero out upper half (if hermitian) */
00142 /*          zero out lower half (if hermitian) */
00143 /*          store the upper half columnwise (if hermitian or upper */
00144 /*                triangular) */
00145 /*          store the lower half columnwise (if hermitian or lower */
00146 /*                triangular) */
00147 /*          store the lower triangle in banded format (if hermitian or */
00148 /*                lower triangular) */
00149 /*          store the upper triangle in banded format (if hermitian or */
00150 /*                upper triangular) */
00151 /*          store the entire matrix in banded format */
00152 /*       If Method B is chosen, and band format is specified, then the */
00153 /*          matrix will be generated in the band format, so no repacking */
00154 /*          will be necessary. */
00155 
00156 /*  Arguments */
00157 /*  ========= */
00158 
00159 /*  M      - INTEGER */
00160 /*           The number of rows of A. Not modified. */
00161 
00162 /*  N      - INTEGER */
00163 /*           The number of columns of A. N must equal M if the matrix */
00164 /*           is symmetric or hermitian (i.e., if SYM is not 'N') */
00165 /*           Not modified. */
00166 
00167 /*  DIST   - CHARACTER*1 */
00168 /*           On entry, DIST specifies the type of distribution to be used */
00169 /*           to generate the random eigen-/singular values. */
00170 /*           'U' => UNIFORM( 0, 1 )  ( 'U' for uniform ) */
00171 /*           'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) */
00172 /*           'N' => NORMAL( 0, 1 )   ( 'N' for normal ) */
00173 /*           Not modified. */
00174 
00175 /*  ISEED  - INTEGER array, dimension ( 4 ) */
00176 /*           On entry ISEED specifies the seed of the random number */
00177 /*           generator. They should lie between 0 and 4095 inclusive, */
00178 /*           and ISEED(4) should be odd. The random number generator */
00179 /*           uses a linear congruential sequence limited to small */
00180 /*           integers, and so should produce machine independent */
00181 /*           random numbers. The values of ISEED are changed on */
00182 /*           exit, and can be used in the next call to ZLATMS */
00183 /*           to continue the same random number sequence. */
00184 /*           Changed on exit. */
00185 
00186 /*  SYM    - CHARACTER*1 */
00187 /*           If SYM='H', the generated matrix is hermitian, with */
00188 /*             eigenvalues specified by D, COND, MODE, and DMAX; they */
00189 /*             may be positive, negative, or zero. */
00190 /*           If SYM='P', the generated matrix is hermitian, with */
00191 /*             eigenvalues (= singular values) specified by D, COND, */
00192 /*             MODE, and DMAX; they will not be negative. */
00193 /*           If SYM='N', the generated matrix is nonsymmetric, with */
00194 /*             singular values specified by D, COND, MODE, and DMAX; */
00195 /*             they will not be negative. */
00196 /*           If SYM='S', the generated matrix is (complex) symmetric, */
00197 /*             with singular values specified by D, COND, MODE, and */
00198 /*             DMAX; they will not be negative. */
00199 /*           Not modified. */
00200 
00201 /*  D      - DOUBLE PRECISION array, dimension ( MIN( M, N ) ) */
00202 /*           This array is used to specify the singular values or */
00203 /*           eigenvalues of A (see SYM, above.)  If MODE=0, then D is */
00204 /*           assumed to contain the singular/eigenvalues, otherwise */
00205 /*           they will be computed according to MODE, COND, and DMAX, */
00206 /*           and placed in D. */
00207 /*           Modified if MODE is nonzero. */
00208 
00209 /*  MODE   - INTEGER */
00210 /*           On entry this describes how the singular/eigenvalues are to */
00211 /*           be specified: */
00212 /*           MODE = 0 means use D as input */
00213 /*           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND */
00214 /*           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND */
00215 /*           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) */
00216 /*           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) */
00217 /*           MODE = 5 sets D to random numbers in the range */
00218 /*                    ( 1/COND , 1 ) such that their logarithms */
00219 /*                    are uniformly distributed. */
00220 /*           MODE = 6 set D to random numbers from same distribution */
00221 /*                    as the rest of the matrix. */
00222 /*           MODE < 0 has the same meaning as ABS(MODE), except that */
00223 /*              the order of the elements of D is reversed. */
00224 /*           Thus if MODE is positive, D has entries ranging from */
00225 /*              1 to 1/COND, if negative, from 1/COND to 1, */
00226 /*           If SYM='H', and MODE is neither 0, 6, nor -6, then */
00227 /*              the elements of D will also be multiplied by a random */
00228 /*              sign (i.e., +1 or -1.) */
00229 /*           Not modified. */
00230 
00231 /*  COND   - DOUBLE PRECISION */
00232 /*           On entry, this is used as described under MODE above. */
00233 /*           If used, it must be >= 1. Not modified. */
00234 
00235 /*  DMAX   - DOUBLE PRECISION */
00236 /*           If MODE is neither -6, 0 nor 6, the contents of D, as */
00237 /*           computed according to MODE and COND, will be scaled by */
00238 /*           DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or */
00239 /*           singular value (which is to say the norm) will be abs(DMAX). */
00240 /*           Note that DMAX need not be positive: if DMAX is negative */
00241 /*           (or zero), D will be scaled by a negative number (or zero). */
00242 /*           Not modified. */
00243 
00244 /*  KL     - INTEGER */
00245 /*           This specifies the lower bandwidth of the  matrix. For */
00246 /*           example, KL=0 implies upper triangular, KL=1 implies upper */
00247 /*           Hessenberg, and KL being at least M-1 means that the matrix */
00248 /*           has full lower bandwidth.  KL must equal KU if the matrix */
00249 /*           is symmetric or hermitian. */
00250 /*           Not modified. */
00251 
00252 /*  KU     - INTEGER */
00253 /*           This specifies the upper bandwidth of the  matrix. For */
00254 /*           example, KU=0 implies lower triangular, KU=1 implies lower */
00255 /*           Hessenberg, and KU being at least N-1 means that the matrix */
00256 /*           has full upper bandwidth.  KL must equal KU if the matrix */
00257 /*           is symmetric or hermitian. */
00258 /*           Not modified. */
00259 
00260 /*  PACK   - CHARACTER*1 */
00261 /*           This specifies packing of matrix as follows: */
00262 /*           'N' => no packing */
00263 /*           'U' => zero out all subdiagonal entries (if symmetric */
00264 /*                  or hermitian) */
00265 /*           'L' => zero out all superdiagonal entries (if symmetric */
00266 /*                  or hermitian) */
00267 /*           'C' => store the upper triangle columnwise (only if the */
00268 /*                  matrix is symmetric, hermitian, or upper triangular) */
00269 /*           'R' => store the lower triangle columnwise (only if the */
00270 /*                  matrix is symmetric, hermitian, or lower triangular) */
00271 /*           'B' => store the lower triangle in band storage scheme */
00272 /*                  (only if the matrix is symmetric, hermitian, or */
00273 /*                  lower triangular) */
00274 /*           'Q' => store the upper triangle in band storage scheme */
00275 /*                  (only if the matrix is symmetric, hermitian, or */
00276 /*                  upper triangular) */
00277 /*           'Z' => store the entire matrix in band storage scheme */
00278 /*                      (pivoting can be provided for by using this */
00279 /*                      option to store A in the trailing rows of */
00280 /*                      the allocated storage) */
00281 
00282 /*           Using these options, the various LAPACK packed and banded */
00283 /*           storage schemes can be obtained: */
00284 /*           GB                    - use 'Z' */
00285 /*           PB, SB, HB, or TB     - use 'B' or 'Q' */
00286 /*           PP, SP, HB, or TP     - use 'C' or 'R' */
00287 
00288 /*           If two calls to ZLATMS differ only in the PACK parameter, */
00289 /*           they will generate mathematically equivalent matrices. */
00290 /*           Not modified. */
00291 
00292 /*  A      - COMPLEX*16 array, dimension ( LDA, N ) */
00293 /*           On exit A is the desired test matrix.  A is first generated */
00294 /*           in full (unpacked) form, and then packed, if so specified */
00295 /*           by PACK.  Thus, the first M elements of the first N */
00296 /*           columns will always be modified.  If PACK specifies a */
00297 /*           packed or banded storage scheme, all LDA elements of the */
00298 /*           first N columns will be modified; the elements of the */
00299 /*           array which do not correspond to elements of the generated */
00300 /*           matrix are set to zero. */
00301 /*           Modified. */
00302 
00303 /*  LDA    - INTEGER */
00304 /*           LDA specifies the first dimension of A as declared in the */
00305 /*           calling program.  If PACK='N', 'U', 'L', 'C', or 'R', then */
00306 /*           LDA must be at least M.  If PACK='B' or 'Q', then LDA must */
00307 /*           be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)). */
00308 /*           If PACK='Z', LDA must be large enough to hold the packed */
00309 /*           array: MIN( KU, N-1) + MIN( KL, M-1) + 1. */
00310 /*           Not modified. */
00311 
00312 /*  WORK   - COMPLEX*16 array, dimension ( 3*MAX( N, M ) ) */
00313 /*           Workspace. */
00314 /*           Modified. */
00315 
00316 /*  INFO   - INTEGER */
00317 /*           Error code.  On exit, INFO will be set to one of the */
00318 /*           following values: */
00319 /*             0 => normal return */
00320 /*            -1 => M negative or unequal to N and SYM='S', 'H', or 'P' */
00321 /*            -2 => N negative */
00322 /*            -3 => DIST illegal string */
00323 /*            -5 => SYM illegal string */
00324 /*            -7 => MODE not in range -6 to 6 */
00325 /*            -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 */
00326 /*           -10 => KL negative */
00327 /*           -11 => KU negative, or SYM is not 'N' and KU is not equal to */
00328 /*                  KL */
00329 /*           -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; */
00330 /*                  or PACK='C' or 'Q' and SYM='N' and KL is not zero; */
00331 /*                  or PACK='R' or 'B' and SYM='N' and KU is not zero; */
00332 /*                  or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not */
00333 /*                  N. */
00334 /*           -14 => LDA is less than M, or PACK='Z' and LDA is less than */
00335 /*                  MIN(KU,N-1) + MIN(KL,M-1) + 1. */
00336 /*            1  => Error return from DLATM1 */
00337 /*            2  => Cannot scale to DMAX (max. sing. value is 0) */
00338 /*            3  => Error return from ZLAGGE, CLAGHE or CLAGSY */
00339 
00340 /*  ===================================================================== */
00341 
00342 /*     .. Parameters .. */
00343 /*     .. */
00344 /*     .. Local Scalars .. */
00345 /*     .. */
00346 /*     .. External Functions .. */
00347 /*     .. */
00348 /*     .. External Subroutines .. */
00349 /*     .. */
00350 /*     .. Intrinsic Functions .. */
00351 /*     .. */
00352 /*     .. Executable Statements .. */
00353 
00354 /*     1)      Decode and Test the input parameters. */
00355 /*             Initialize flags & seed. */
00356 
00357     /* Parameter adjustments */
00358     --iseed;
00359     --d__;
00360     a_dim1 = *lda;
00361     a_offset = 1 + a_dim1;
00362     a -= a_offset;
00363     --work;
00364 
00365     /* Function Body */
00366     *info = 0;
00367 
00368 /*     Quick return if possible */
00369 
00370     if (*m == 0 || *n == 0) {
00371         return 0;
00372     }
00373 
00374 /*     Decode DIST */
00375 
00376     if (lsame_(dist, "U")) {
00377         idist = 1;
00378     } else if (lsame_(dist, "S")) {
00379         idist = 2;
00380     } else if (lsame_(dist, "N")) {
00381         idist = 3;
00382     } else {
00383         idist = -1;
00384     }
00385 
00386 /*     Decode SYM */
00387 
00388     if (lsame_(sym, "N")) {
00389         isym = 1;
00390         irsign = 0;
00391         zsym = FALSE_;
00392     } else if (lsame_(sym, "P")) {
00393         isym = 2;
00394         irsign = 0;
00395         zsym = FALSE_;
00396     } else if (lsame_(sym, "S")) {
00397         isym = 2;
00398         irsign = 0;
00399         zsym = TRUE_;
00400     } else if (lsame_(sym, "H")) {
00401         isym = 2;
00402         irsign = 1;
00403         zsym = FALSE_;
00404     } else {
00405         isym = -1;
00406     }
00407 
00408 /*     Decode PACK */
00409 
00410     isympk = 0;
00411     if (lsame_(pack, "N")) {
00412         ipack = 0;
00413     } else if (lsame_(pack, "U")) {
00414         ipack = 1;
00415         isympk = 1;
00416     } else if (lsame_(pack, "L")) {
00417         ipack = 2;
00418         isympk = 1;
00419     } else if (lsame_(pack, "C")) {
00420         ipack = 3;
00421         isympk = 2;
00422     } else if (lsame_(pack, "R")) {
00423         ipack = 4;
00424         isympk = 3;
00425     } else if (lsame_(pack, "B")) {
00426         ipack = 5;
00427         isympk = 3;
00428     } else if (lsame_(pack, "Q")) {
00429         ipack = 6;
00430         isympk = 2;
00431     } else if (lsame_(pack, "Z")) {
00432         ipack = 7;
00433     } else {
00434         ipack = -1;
00435     }
00436 
00437 /*     Set certain internal parameters */
00438 
00439     mnmin = min(*m,*n);
00440 /* Computing MIN */
00441     i__1 = *kl, i__2 = *m - 1;
00442     llb = min(i__1,i__2);
00443 /* Computing MIN */
00444     i__1 = *ku, i__2 = *n - 1;
00445     uub = min(i__1,i__2);
00446 /* Computing MIN */
00447     i__1 = *m, i__2 = *n + llb;
00448     mr = min(i__1,i__2);
00449 /* Computing MIN */
00450     i__1 = *n, i__2 = *m + uub;
00451     nc = min(i__1,i__2);
00452 
00453     if (ipack == 5 || ipack == 6) {
00454         minlda = uub + 1;
00455     } else if (ipack == 7) {
00456         minlda = llb + uub + 1;
00457     } else {
00458         minlda = *m;
00459     }
00460 
00461 /*     Use Givens rotation method if bandwidth small enough, */
00462 /*     or if LDA is too small to store the matrix unpacked. */
00463 
00464     givens = FALSE_;
00465     if (isym == 1) {
00466 /* Computing MAX */
00467         i__1 = 1, i__2 = mr + nc;
00468         if ((doublereal) (llb + uub) < (doublereal) max(i__1,i__2) * .3) {
00469             givens = TRUE_;
00470         }
00471     } else {
00472         if (llb << 1 < *m) {
00473             givens = TRUE_;
00474         }
00475     }
00476     if (*lda < *m && *lda >= minlda) {
00477         givens = TRUE_;
00478     }
00479 
00480 /*     Set INFO if an error */
00481 
00482     if (*m < 0) {
00483         *info = -1;
00484     } else if (*m != *n && isym != 1) {
00485         *info = -1;
00486     } else if (*n < 0) {
00487         *info = -2;
00488     } else if (idist == -1) {
00489         *info = -3;
00490     } else if (isym == -1) {
00491         *info = -5;
00492     } else if (abs(*mode) > 6) {
00493         *info = -7;
00494     } else if (*mode != 0 && abs(*mode) != 6 && *cond < 1.) {
00495         *info = -8;
00496     } else if (*kl < 0) {
00497         *info = -10;
00498     } else if (*ku < 0 || isym != 1 && *kl != *ku) {
00499         *info = -11;
00500     } else if (ipack == -1 || isympk == 1 && isym == 1 || isympk == 2 && isym 
00501             == 1 && *kl > 0 || isympk == 3 && isym == 1 && *ku > 0 || isympk 
00502             != 0 && *m != *n) {
00503         *info = -12;
00504     } else if (*lda < max(1,minlda)) {
00505         *info = -14;
00506     }
00507 
00508     if (*info != 0) {
00509         i__1 = -(*info);
00510         xerbla_("ZLATMS", &i__1);
00511         return 0;
00512     }
00513 
00514 /*     Initialize random number generator */
00515 
00516     for (i__ = 1; i__ <= 4; ++i__) {
00517         iseed[i__] = (i__1 = iseed[i__], abs(i__1)) % 4096;
00518 /* L10: */
00519     }
00520 
00521     if (iseed[4] % 2 != 1) {
00522         ++iseed[4];
00523     }
00524 
00525 /*     2)      Set up D  if indicated. */
00526 
00527 /*             Compute D according to COND and MODE */
00528 
00529     dlatm1_(mode, cond, &irsign, &idist, &iseed[1], &d__[1], &mnmin, &iinfo);
00530     if (iinfo != 0) {
00531         *info = 1;
00532         return 0;
00533     }
00534 
00535 /*     Choose Top-Down if D is (apparently) increasing, */
00536 /*     Bottom-Up if D is (apparently) decreasing. */
00537 
00538     if (abs(d__[1]) <= (d__1 = d__[mnmin], abs(d__1))) {
00539         topdwn = TRUE_;
00540     } else {
00541         topdwn = FALSE_;
00542     }
00543 
00544     if (*mode != 0 && abs(*mode) != 6) {
00545 
00546 /*        Scale by DMAX */
00547 
00548         temp = abs(d__[1]);
00549         i__1 = mnmin;
00550         for (i__ = 2; i__ <= i__1; ++i__) {
00551 /* Computing MAX */
00552             d__2 = temp, d__3 = (d__1 = d__[i__], abs(d__1));
00553             temp = max(d__2,d__3);
00554 /* L20: */
00555         }
00556 
00557         if (temp > 0.) {
00558             alpha = *dmax__ / temp;
00559         } else {
00560             *info = 2;
00561             return 0;
00562         }
00563 
00564         dscal_(&mnmin, &alpha, &d__[1], &c__1);
00565 
00566     }
00567 
00568     zlaset_("Full", lda, n, &c_b1, &c_b1, &a[a_offset], lda);
00569 
00570 /*     3)      Generate Banded Matrix using Givens rotations. */
00571 /*             Also the special case of UUB=LLB=0 */
00572 
00573 /*               Compute Addressing constants to cover all */
00574 /*               storage formats.  Whether GE, HE, SY, GB, HB, or SB, */
00575 /*               upper or lower triangle or both, */
00576 /*               the (i,j)-th element is in */
00577 /*               A( i - ISKEW*j + IOFFST, j ) */
00578 
00579     if (ipack > 4) {
00580         ilda = *lda - 1;
00581         iskew = 1;
00582         if (ipack > 5) {
00583             ioffst = uub + 1;
00584         } else {
00585             ioffst = 1;
00586         }
00587     } else {
00588         ilda = *lda;
00589         iskew = 0;
00590         ioffst = 0;
00591     }
00592 
00593 /*     IPACKG is the format that the matrix is generated in. If this is */
00594 /*     different from IPACK, then the matrix must be repacked at the */
00595 /*     end.  It also signals how to compute the norm, for scaling. */
00596 
00597     ipackg = 0;
00598 
00599 /*     Diagonal Matrix -- We are done, unless it */
00600 /*     is to be stored HP/SP/PP/TP (PACK='R' or 'C') */
00601 
00602     if (llb == 0 && uub == 0) {
00603         i__1 = mnmin;
00604         for (j = 1; j <= i__1; ++j) {
00605             i__2 = (1 - iskew) * j + ioffst + j * a_dim1;
00606             i__3 = j;
00607             z__1.r = d__[i__3], z__1.i = 0.;
00608             a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00609 /* L30: */
00610         }
00611 
00612         if (ipack <= 2 || ipack >= 5) {
00613             ipackg = ipack;
00614         }
00615 
00616     } else if (givens) {
00617 
00618 /*        Check whether to use Givens rotations, */
00619 /*        Householder transformations, or nothing. */
00620 
00621         if (isym == 1) {
00622 
00623 /*           Non-symmetric -- A = U D V */
00624 
00625             if (ipack > 4) {
00626                 ipackg = ipack;
00627             } else {
00628                 ipackg = 0;
00629             }
00630 
00631             i__1 = mnmin;
00632             for (j = 1; j <= i__1; ++j) {
00633                 i__2 = (1 - iskew) * j + ioffst + j * a_dim1;
00634                 i__3 = j;
00635                 z__1.r = d__[i__3], z__1.i = 0.;
00636                 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00637 /* L40: */
00638             }
00639 
00640             if (topdwn) {
00641                 jkl = 0;
00642                 i__1 = uub;
00643                 for (jku = 1; jku <= i__1; ++jku) {
00644 
00645 /*                 Transform from bandwidth JKL, JKU-1 to JKL, JKU */
00646 
00647 /*                 Last row actually rotated is M */
00648 /*                 Last column actually rotated is MIN( M+JKU, N ) */
00649 
00650 /* Computing MIN */
00651                     i__3 = *m + jku;
00652                     i__2 = min(i__3,*n) + jkl - 1;
00653                     for (jr = 1; jr <= i__2; ++jr) {
00654                         extra.r = 0., extra.i = 0.;
00655                         angle = dlarnd_(&c__1, &iseed[1]) * 
00656                                 6.2831853071795864769252867663;
00657                         d__1 = cos(angle);
00658                         zlarnd_(&z__2, &c__5, &iseed[1]);
00659                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00660                         c__.r = z__1.r, c__.i = z__1.i;
00661                         d__1 = sin(angle);
00662                         zlarnd_(&z__2, &c__5, &iseed[1]);
00663                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00664                         s.r = z__1.r, s.i = z__1.i;
00665 /* Computing MAX */
00666                         i__3 = 1, i__4 = jr - jkl;
00667                         icol = max(i__3,i__4);
00668                         if (jr < *m) {
00669 /* Computing MIN */
00670                             i__3 = *n, i__4 = jr + jku;
00671                             il = min(i__3,i__4) + 1 - icol;
00672                             L__1 = jr > jkl;
00673                             zlarot_(&c_true, &L__1, &c_false, &il, &c__, &s, &
00674                                     a[jr - iskew * icol + ioffst + icol * 
00675                                     a_dim1], &ilda, &extra, &dummy);
00676                         }
00677 
00678 /*                    Chase "EXTRA" back up */
00679 
00680                         ir = jr;
00681                         ic = icol;
00682                         i__3 = -jkl - jku;
00683                         for (jch = jr - jkl; i__3 < 0 ? jch >= 1 : jch <= 1; 
00684                                 jch += i__3) {
00685                             if (ir < *m) {
00686                                 zlartg_(&a[ir + 1 - iskew * (ic + 1) + ioffst 
00687                                         + (ic + 1) * a_dim1], &extra, &realc, 
00688                                         &s, &dummy);
00689                                 zlarnd_(&z__1, &c__5, &iseed[1]);
00690                                 dummy.r = z__1.r, dummy.i = z__1.i;
00691                                 z__2.r = realc * dummy.r, z__2.i = realc * 
00692                                         dummy.i;
00693                                 d_cnjg(&z__1, &z__2);
00694                                 c__.r = z__1.r, c__.i = z__1.i;
00695                                 z__3.r = -s.r, z__3.i = -s.i;
00696                                 z__2.r = z__3.r * dummy.r - z__3.i * dummy.i, 
00697                                         z__2.i = z__3.r * dummy.i + z__3.i * 
00698                                         dummy.r;
00699                                 d_cnjg(&z__1, &z__2);
00700                                 s.r = z__1.r, s.i = z__1.i;
00701                             }
00702 /* Computing MAX */
00703                             i__4 = 1, i__5 = jch - jku;
00704                             irow = max(i__4,i__5);
00705                             il = ir + 2 - irow;
00706                             ctemp.r = 0., ctemp.i = 0.;
00707                             iltemp = jch > jku;
00708                             zlarot_(&c_false, &iltemp, &c_true, &il, &c__, &s, 
00709                                      &a[irow - iskew * ic + ioffst + ic * 
00710                                     a_dim1], &ilda, &ctemp, &extra);
00711                             if (iltemp) {
00712                                 zlartg_(&a[irow + 1 - iskew * (ic + 1) + 
00713                                         ioffst + (ic + 1) * a_dim1], &ctemp, &
00714                                         realc, &s, &dummy);
00715                                 zlarnd_(&z__1, &c__5, &iseed[1]);
00716                                 dummy.r = z__1.r, dummy.i = z__1.i;
00717                                 z__2.r = realc * dummy.r, z__2.i = realc * 
00718                                         dummy.i;
00719                                 d_cnjg(&z__1, &z__2);
00720                                 c__.r = z__1.r, c__.i = z__1.i;
00721                                 z__3.r = -s.r, z__3.i = -s.i;
00722                                 z__2.r = z__3.r * dummy.r - z__3.i * dummy.i, 
00723                                         z__2.i = z__3.r * dummy.i + z__3.i * 
00724                                         dummy.r;
00725                                 d_cnjg(&z__1, &z__2);
00726                                 s.r = z__1.r, s.i = z__1.i;
00727 
00728 /* Computing MAX */
00729                                 i__4 = 1, i__5 = jch - jku - jkl;
00730                                 icol = max(i__4,i__5);
00731                                 il = ic + 2 - icol;
00732                                 extra.r = 0., extra.i = 0.;
00733                                 L__1 = jch > jku + jkl;
00734                                 zlarot_(&c_true, &L__1, &c_true, &il, &c__, &
00735                                         s, &a[irow - iskew * icol + ioffst + 
00736                                         icol * a_dim1], &ilda, &extra, &ctemp)
00737                                         ;
00738                                 ic = icol;
00739                                 ir = irow;
00740                             }
00741 /* L50: */
00742                         }
00743 /* L60: */
00744                     }
00745 /* L70: */
00746                 }
00747 
00748                 jku = uub;
00749                 i__1 = llb;
00750                 for (jkl = 1; jkl <= i__1; ++jkl) {
00751 
00752 /*                 Transform from bandwidth JKL-1, JKU to JKL, JKU */
00753 
00754 /* Computing MIN */
00755                     i__3 = *n + jkl;
00756                     i__2 = min(i__3,*m) + jku - 1;
00757                     for (jc = 1; jc <= i__2; ++jc) {
00758                         extra.r = 0., extra.i = 0.;
00759                         angle = dlarnd_(&c__1, &iseed[1]) * 
00760                                 6.2831853071795864769252867663;
00761                         d__1 = cos(angle);
00762                         zlarnd_(&z__2, &c__5, &iseed[1]);
00763                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00764                         c__.r = z__1.r, c__.i = z__1.i;
00765                         d__1 = sin(angle);
00766                         zlarnd_(&z__2, &c__5, &iseed[1]);
00767                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00768                         s.r = z__1.r, s.i = z__1.i;
00769 /* Computing MAX */
00770                         i__3 = 1, i__4 = jc - jku;
00771                         irow = max(i__3,i__4);
00772                         if (jc < *n) {
00773 /* Computing MIN */
00774                             i__3 = *m, i__4 = jc + jkl;
00775                             il = min(i__3,i__4) + 1 - irow;
00776                             L__1 = jc > jku;
00777                             zlarot_(&c_false, &L__1, &c_false, &il, &c__, &s, 
00778                                     &a[irow - iskew * jc + ioffst + jc * 
00779                                     a_dim1], &ilda, &extra, &dummy);
00780                         }
00781 
00782 /*                    Chase "EXTRA" back up */
00783 
00784                         ic = jc;
00785                         ir = irow;
00786                         i__3 = -jkl - jku;
00787                         for (jch = jc - jku; i__3 < 0 ? jch >= 1 : jch <= 1; 
00788                                 jch += i__3) {
00789                             if (ic < *n) {
00790                                 zlartg_(&a[ir + 1 - iskew * (ic + 1) + ioffst 
00791                                         + (ic + 1) * a_dim1], &extra, &realc, 
00792                                         &s, &dummy);
00793                                 zlarnd_(&z__1, &c__5, &iseed[1]);
00794                                 dummy.r = z__1.r, dummy.i = z__1.i;
00795                                 z__2.r = realc * dummy.r, z__2.i = realc * 
00796                                         dummy.i;
00797                                 d_cnjg(&z__1, &z__2);
00798                                 c__.r = z__1.r, c__.i = z__1.i;
00799                                 z__3.r = -s.r, z__3.i = -s.i;
00800                                 z__2.r = z__3.r * dummy.r - z__3.i * dummy.i, 
00801                                         z__2.i = z__3.r * dummy.i + z__3.i * 
00802                                         dummy.r;
00803                                 d_cnjg(&z__1, &z__2);
00804                                 s.r = z__1.r, s.i = z__1.i;
00805                             }
00806 /* Computing MAX */
00807                             i__4 = 1, i__5 = jch - jkl;
00808                             icol = max(i__4,i__5);
00809                             il = ic + 2 - icol;
00810                             ctemp.r = 0., ctemp.i = 0.;
00811                             iltemp = jch > jkl;
00812                             zlarot_(&c_true, &iltemp, &c_true, &il, &c__, &s, 
00813                                     &a[ir - iskew * icol + ioffst + icol * 
00814                                     a_dim1], &ilda, &ctemp, &extra);
00815                             if (iltemp) {
00816                                 zlartg_(&a[ir + 1 - iskew * (icol + 1) + 
00817                                         ioffst + (icol + 1) * a_dim1], &ctemp, 
00818                                          &realc, &s, &dummy);
00819                                 zlarnd_(&z__1, &c__5, &iseed[1]);
00820                                 dummy.r = z__1.r, dummy.i = z__1.i;
00821                                 z__2.r = realc * dummy.r, z__2.i = realc * 
00822                                         dummy.i;
00823                                 d_cnjg(&z__1, &z__2);
00824                                 c__.r = z__1.r, c__.i = z__1.i;
00825                                 z__3.r = -s.r, z__3.i = -s.i;
00826                                 z__2.r = z__3.r * dummy.r - z__3.i * dummy.i, 
00827                                         z__2.i = z__3.r * dummy.i + z__3.i * 
00828                                         dummy.r;
00829                                 d_cnjg(&z__1, &z__2);
00830                                 s.r = z__1.r, s.i = z__1.i;
00831 /* Computing MAX */
00832                                 i__4 = 1, i__5 = jch - jkl - jku;
00833                                 irow = max(i__4,i__5);
00834                                 il = ir + 2 - irow;
00835                                 extra.r = 0., extra.i = 0.;
00836                                 L__1 = jch > jkl + jku;
00837                                 zlarot_(&c_false, &L__1, &c_true, &il, &c__, &
00838                                         s, &a[irow - iskew * icol + ioffst + 
00839                                         icol * a_dim1], &ilda, &extra, &ctemp)
00840                                         ;
00841                                 ic = icol;
00842                                 ir = irow;
00843                             }
00844 /* L80: */
00845                         }
00846 /* L90: */
00847                     }
00848 /* L100: */
00849                 }
00850 
00851             } else {
00852 
00853 /*              Bottom-Up -- Start at the bottom right. */
00854 
00855                 jkl = 0;
00856                 i__1 = uub;
00857                 for (jku = 1; jku <= i__1; ++jku) {
00858 
00859 /*                 Transform from bandwidth JKL, JKU-1 to JKL, JKU */
00860 
00861 /*                 First row actually rotated is M */
00862 /*                 First column actually rotated is MIN( M+JKU, N ) */
00863 
00864 /* Computing MIN */
00865                     i__2 = *m, i__3 = *n + jkl;
00866                     iendch = min(i__2,i__3) - 1;
00867 /* Computing MIN */
00868                     i__2 = *m + jku;
00869                     i__3 = 1 - jkl;
00870                     for (jc = min(i__2,*n) - 1; jc >= i__3; --jc) {
00871                         extra.r = 0., extra.i = 0.;
00872                         angle = dlarnd_(&c__1, &iseed[1]) * 
00873                                 6.2831853071795864769252867663;
00874                         d__1 = cos(angle);
00875                         zlarnd_(&z__2, &c__5, &iseed[1]);
00876                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00877                         c__.r = z__1.r, c__.i = z__1.i;
00878                         d__1 = sin(angle);
00879                         zlarnd_(&z__2, &c__5, &iseed[1]);
00880                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00881                         s.r = z__1.r, s.i = z__1.i;
00882 /* Computing MAX */
00883                         i__2 = 1, i__4 = jc - jku + 1;
00884                         irow = max(i__2,i__4);
00885                         if (jc > 0) {
00886 /* Computing MIN */
00887                             i__2 = *m, i__4 = jc + jkl + 1;
00888                             il = min(i__2,i__4) + 1 - irow;
00889                             L__1 = jc + jkl < *m;
00890                             zlarot_(&c_false, &c_false, &L__1, &il, &c__, &s, 
00891                                     &a[irow - iskew * jc + ioffst + jc * 
00892                                     a_dim1], &ilda, &dummy, &extra);
00893                         }
00894 
00895 /*                    Chase "EXTRA" back down */
00896 
00897                         ic = jc;
00898                         i__2 = iendch;
00899                         i__4 = jkl + jku;
00900                         for (jch = jc + jkl; i__4 < 0 ? jch >= i__2 : jch <= 
00901                                 i__2; jch += i__4) {
00902                             ilextr = ic > 0;
00903                             if (ilextr) {
00904                                 zlartg_(&a[jch - iskew * ic + ioffst + ic * 
00905                                         a_dim1], &extra, &realc, &s, &dummy);
00906                                 zlarnd_(&z__1, &c__5, &iseed[1]);
00907                                 dummy.r = z__1.r, dummy.i = z__1.i;
00908                                 z__1.r = realc * dummy.r, z__1.i = realc * 
00909                                         dummy.i;
00910                                 c__.r = z__1.r, c__.i = z__1.i;
00911                                 z__1.r = s.r * dummy.r - s.i * dummy.i, 
00912                                         z__1.i = s.r * dummy.i + s.i * 
00913                                         dummy.r;
00914                                 s.r = z__1.r, s.i = z__1.i;
00915                             }
00916                             ic = max(1,ic);
00917 /* Computing MIN */
00918                             i__5 = *n - 1, i__6 = jch + jku;
00919                             icol = min(i__5,i__6);
00920                             iltemp = jch + jku < *n;
00921                             ctemp.r = 0., ctemp.i = 0.;
00922                             i__5 = icol + 2 - ic;
00923                             zlarot_(&c_true, &ilextr, &iltemp, &i__5, &c__, &
00924                                     s, &a[jch - iskew * ic + ioffst + ic * 
00925                                     a_dim1], &ilda, &extra, &ctemp);
00926                             if (iltemp) {
00927                                 zlartg_(&a[jch - iskew * icol + ioffst + icol 
00928                                         * a_dim1], &ctemp, &realc, &s, &dummy)
00929                                         ;
00930                                 zlarnd_(&z__1, &c__5, &iseed[1]);
00931                                 dummy.r = z__1.r, dummy.i = z__1.i;
00932                                 z__1.r = realc * dummy.r, z__1.i = realc * 
00933                                         dummy.i;
00934                                 c__.r = z__1.r, c__.i = z__1.i;
00935                                 z__1.r = s.r * dummy.r - s.i * dummy.i, 
00936                                         z__1.i = s.r * dummy.i + s.i * 
00937                                         dummy.r;
00938                                 s.r = z__1.r, s.i = z__1.i;
00939 /* Computing MIN */
00940                                 i__5 = iendch, i__6 = jch + jkl + jku;
00941                                 il = min(i__5,i__6) + 2 - jch;
00942                                 extra.r = 0., extra.i = 0.;
00943                                 L__1 = jch + jkl + jku <= iendch;
00944                                 zlarot_(&c_false, &c_true, &L__1, &il, &c__, &
00945                                         s, &a[jch - iskew * icol + ioffst + 
00946                                         icol * a_dim1], &ilda, &ctemp, &extra)
00947                                         ;
00948                                 ic = icol;
00949                             }
00950 /* L110: */
00951                         }
00952 /* L120: */
00953                     }
00954 /* L130: */
00955                 }
00956 
00957                 jku = uub;
00958                 i__1 = llb;
00959                 for (jkl = 1; jkl <= i__1; ++jkl) {
00960 
00961 /*                 Transform from bandwidth JKL-1, JKU to JKL, JKU */
00962 
00963 /*                 First row actually rotated is MIN( N+JKL, M ) */
00964 /*                 First column actually rotated is N */
00965 
00966 /* Computing MIN */
00967                     i__3 = *n, i__4 = *m + jku;
00968                     iendch = min(i__3,i__4) - 1;
00969 /* Computing MIN */
00970                     i__3 = *n + jkl;
00971                     i__4 = 1 - jku;
00972                     for (jr = min(i__3,*m) - 1; jr >= i__4; --jr) {
00973                         extra.r = 0., extra.i = 0.;
00974                         angle = dlarnd_(&c__1, &iseed[1]) * 
00975                                 6.2831853071795864769252867663;
00976                         d__1 = cos(angle);
00977                         zlarnd_(&z__2, &c__5, &iseed[1]);
00978                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00979                         c__.r = z__1.r, c__.i = z__1.i;
00980                         d__1 = sin(angle);
00981                         zlarnd_(&z__2, &c__5, &iseed[1]);
00982                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
00983                         s.r = z__1.r, s.i = z__1.i;
00984 /* Computing MAX */
00985                         i__3 = 1, i__2 = jr - jkl + 1;
00986                         icol = max(i__3,i__2);
00987                         if (jr > 0) {
00988 /* Computing MIN */
00989                             i__3 = *n, i__2 = jr + jku + 1;
00990                             il = min(i__3,i__2) + 1 - icol;
00991                             L__1 = jr + jku < *n;
00992                             zlarot_(&c_true, &c_false, &L__1, &il, &c__, &s, &
00993                                     a[jr - iskew * icol + ioffst + icol * 
00994                                     a_dim1], &ilda, &dummy, &extra);
00995                         }
00996 
00997 /*                    Chase "EXTRA" back down */
00998 
00999                         ir = jr;
01000                         i__3 = iendch;
01001                         i__2 = jkl + jku;
01002                         for (jch = jr + jku; i__2 < 0 ? jch >= i__3 : jch <= 
01003                                 i__3; jch += i__2) {
01004                             ilextr = ir > 0;
01005                             if (ilextr) {
01006                                 zlartg_(&a[ir - iskew * jch + ioffst + jch * 
01007                                         a_dim1], &extra, &realc, &s, &dummy);
01008                                 zlarnd_(&z__1, &c__5, &iseed[1]);
01009                                 dummy.r = z__1.r, dummy.i = z__1.i;
01010                                 z__1.r = realc * dummy.r, z__1.i = realc * 
01011                                         dummy.i;
01012                                 c__.r = z__1.r, c__.i = z__1.i;
01013                                 z__1.r = s.r * dummy.r - s.i * dummy.i, 
01014                                         z__1.i = s.r * dummy.i + s.i * 
01015                                         dummy.r;
01016                                 s.r = z__1.r, s.i = z__1.i;
01017                             }
01018                             ir = max(1,ir);
01019 /* Computing MIN */
01020                             i__5 = *m - 1, i__6 = jch + jkl;
01021                             irow = min(i__5,i__6);
01022                             iltemp = jch + jkl < *m;
01023                             ctemp.r = 0., ctemp.i = 0.;
01024                             i__5 = irow + 2 - ir;
01025                             zlarot_(&c_false, &ilextr, &iltemp, &i__5, &c__, &
01026                                     s, &a[ir - iskew * jch + ioffst + jch * 
01027                                     a_dim1], &ilda, &extra, &ctemp);
01028                             if (iltemp) {
01029                                 zlartg_(&a[irow - iskew * jch + ioffst + jch *
01030                                          a_dim1], &ctemp, &realc, &s, &dummy);
01031                                 zlarnd_(&z__1, &c__5, &iseed[1]);
01032                                 dummy.r = z__1.r, dummy.i = z__1.i;
01033                                 z__1.r = realc * dummy.r, z__1.i = realc * 
01034                                         dummy.i;
01035                                 c__.r = z__1.r, c__.i = z__1.i;
01036                                 z__1.r = s.r * dummy.r - s.i * dummy.i, 
01037                                         z__1.i = s.r * dummy.i + s.i * 
01038                                         dummy.r;
01039                                 s.r = z__1.r, s.i = z__1.i;
01040 /* Computing MIN */
01041                                 i__5 = iendch, i__6 = jch + jkl + jku;
01042                                 il = min(i__5,i__6) + 2 - jch;
01043                                 extra.r = 0., extra.i = 0.;
01044                                 L__1 = jch + jkl + jku <= iendch;
01045                                 zlarot_(&c_true, &c_true, &L__1, &il, &c__, &
01046                                         s, &a[irow - iskew * jch + ioffst + 
01047                                         jch * a_dim1], &ilda, &ctemp, &extra);
01048                                 ir = irow;
01049                             }
01050 /* L140: */
01051                         }
01052 /* L150: */
01053                     }
01054 /* L160: */
01055                 }
01056 
01057             }
01058 
01059         } else {
01060 
01061 /*           Symmetric -- A = U D U' */
01062 /*           Hermitian -- A = U D U* */
01063 
01064             ipackg = ipack;
01065             ioffg = ioffst;
01066 
01067             if (topdwn) {
01068 
01069 /*              Top-Down -- Generate Upper triangle only */
01070 
01071                 if (ipack >= 5) {
01072                     ipackg = 6;
01073                     ioffg = uub + 1;
01074                 } else {
01075                     ipackg = 1;
01076                 }
01077 
01078                 i__1 = mnmin;
01079                 for (j = 1; j <= i__1; ++j) {
01080                     i__4 = (1 - iskew) * j + ioffg + j * a_dim1;
01081                     i__2 = j;
01082                     z__1.r = d__[i__2], z__1.i = 0.;
01083                     a[i__4].r = z__1.r, a[i__4].i = z__1.i;
01084 /* L170: */
01085                 }
01086 
01087                 i__1 = uub;
01088                 for (k = 1; k <= i__1; ++k) {
01089                     i__4 = *n - 1;
01090                     for (jc = 1; jc <= i__4; ++jc) {
01091 /* Computing MAX */
01092                         i__2 = 1, i__3 = jc - k;
01093                         irow = max(i__2,i__3);
01094 /* Computing MIN */
01095                         i__2 = jc + 1, i__3 = k + 2;
01096                         il = min(i__2,i__3);
01097                         extra.r = 0., extra.i = 0.;
01098                         i__2 = jc - iskew * (jc + 1) + ioffg + (jc + 1) * 
01099                                 a_dim1;
01100                         ctemp.r = a[i__2].r, ctemp.i = a[i__2].i;
01101                         angle = dlarnd_(&c__1, &iseed[1]) * 
01102                                 6.2831853071795864769252867663;
01103                         d__1 = cos(angle);
01104                         zlarnd_(&z__2, &c__5, &iseed[1]);
01105                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
01106                         c__.r = z__1.r, c__.i = z__1.i;
01107                         d__1 = sin(angle);
01108                         zlarnd_(&z__2, &c__5, &iseed[1]);
01109                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
01110                         s.r = z__1.r, s.i = z__1.i;
01111                         if (zsym) {
01112                             ct.r = c__.r, ct.i = c__.i;
01113                             st.r = s.r, st.i = s.i;
01114                         } else {
01115                             d_cnjg(&z__1, &ctemp);
01116                             ctemp.r = z__1.r, ctemp.i = z__1.i;
01117                             d_cnjg(&z__1, &c__);
01118                             ct.r = z__1.r, ct.i = z__1.i;
01119                             d_cnjg(&z__1, &s);
01120                             st.r = z__1.r, st.i = z__1.i;
01121                         }
01122                         L__1 = jc > k;
01123                         zlarot_(&c_false, &L__1, &c_true, &il, &c__, &s, &a[
01124                                 irow - iskew * jc + ioffg + jc * a_dim1], &
01125                                 ilda, &extra, &ctemp);
01126 /* Computing MIN */
01127                         i__3 = k, i__5 = *n - jc;
01128                         i__2 = min(i__3,i__5) + 1;
01129                         zlarot_(&c_true, &c_true, &c_false, &i__2, &ct, &st, &
01130                                 a[(1 - iskew) * jc + ioffg + jc * a_dim1], &
01131                                 ilda, &ctemp, &dummy);
01132 
01133 /*                    Chase EXTRA back up the matrix */
01134 
01135                         icol = jc;
01136                         i__2 = -k;
01137                         for (jch = jc - k; i__2 < 0 ? jch >= 1 : jch <= 1; 
01138                                 jch += i__2) {
01139                             zlartg_(&a[jch + 1 - iskew * (icol + 1) + ioffg + 
01140                                     (icol + 1) * a_dim1], &extra, &realc, &s, 
01141                                     &dummy);
01142                             zlarnd_(&z__1, &c__5, &iseed[1]);
01143                             dummy.r = z__1.r, dummy.i = z__1.i;
01144                             z__2.r = realc * dummy.r, z__2.i = realc * 
01145                                     dummy.i;
01146                             d_cnjg(&z__1, &z__2);
01147                             c__.r = z__1.r, c__.i = z__1.i;
01148                             z__3.r = -s.r, z__3.i = -s.i;
01149                             z__2.r = z__3.r * dummy.r - z__3.i * dummy.i, 
01150                                     z__2.i = z__3.r * dummy.i + z__3.i * 
01151                                     dummy.r;
01152                             d_cnjg(&z__1, &z__2);
01153                             s.r = z__1.r, s.i = z__1.i;
01154                             i__3 = jch - iskew * (jch + 1) + ioffg + (jch + 1)
01155                                      * a_dim1;
01156                             ctemp.r = a[i__3].r, ctemp.i = a[i__3].i;
01157                             if (zsym) {
01158                                 ct.r = c__.r, ct.i = c__.i;
01159                                 st.r = s.r, st.i = s.i;
01160                             } else {
01161                                 d_cnjg(&z__1, &ctemp);
01162                                 ctemp.r = z__1.r, ctemp.i = z__1.i;
01163                                 d_cnjg(&z__1, &c__);
01164                                 ct.r = z__1.r, ct.i = z__1.i;
01165                                 d_cnjg(&z__1, &s);
01166                                 st.r = z__1.r, st.i = z__1.i;
01167                             }
01168                             i__3 = k + 2;
01169                             zlarot_(&c_true, &c_true, &c_true, &i__3, &c__, &
01170                                     s, &a[(1 - iskew) * jch + ioffg + jch * 
01171                                     a_dim1], &ilda, &ctemp, &extra);
01172 /* Computing MAX */
01173                             i__3 = 1, i__5 = jch - k;
01174                             irow = max(i__3,i__5);
01175 /* Computing MIN */
01176                             i__3 = jch + 1, i__5 = k + 2;
01177                             il = min(i__3,i__5);
01178                             extra.r = 0., extra.i = 0.;
01179                             L__1 = jch > k;
01180                             zlarot_(&c_false, &L__1, &c_true, &il, &ct, &st, &
01181                                     a[irow - iskew * jch + ioffg + jch * 
01182                                     a_dim1], &ilda, &extra, &ctemp);
01183                             icol = jch;
01184 /* L180: */
01185                         }
01186 /* L190: */
01187                     }
01188 /* L200: */
01189                 }
01190 
01191 /*              If we need lower triangle, copy from upper. Note that */
01192 /*              the order of copying is chosen to work for 'q' -> 'b' */
01193 
01194                 if (ipack != ipackg && ipack != 3) {
01195                     i__1 = *n;
01196                     for (jc = 1; jc <= i__1; ++jc) {
01197                         irow = ioffst - iskew * jc;
01198                         if (zsym) {
01199 /* Computing MIN */
01200                             i__2 = *n, i__3 = jc + uub;
01201                             i__4 = min(i__2,i__3);
01202                             for (jr = jc; jr <= i__4; ++jr) {
01203                                 i__2 = jr + irow + jc * a_dim1;
01204                                 i__3 = jc - iskew * jr + ioffg + jr * a_dim1;
01205                                 a[i__2].r = a[i__3].r, a[i__2].i = a[i__3].i;
01206 /* L210: */
01207                             }
01208                         } else {
01209 /* Computing MIN */
01210                             i__2 = *n, i__3 = jc + uub;
01211                             i__4 = min(i__2,i__3);
01212                             for (jr = jc; jr <= i__4; ++jr) {
01213                                 i__2 = jr + irow + jc * a_dim1;
01214                                 d_cnjg(&z__1, &a[jc - iskew * jr + ioffg + jr 
01215                                         * a_dim1]);
01216                                 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
01217 /* L220: */
01218                             }
01219                         }
01220 /* L230: */
01221                     }
01222                     if (ipack == 5) {
01223                         i__1 = *n;
01224                         for (jc = *n - uub + 1; jc <= i__1; ++jc) {
01225                             i__4 = uub + 1;
01226                             for (jr = *n + 2 - jc; jr <= i__4; ++jr) {
01227                                 i__2 = jr + jc * a_dim1;
01228                                 a[i__2].r = 0., a[i__2].i = 0.;
01229 /* L240: */
01230                             }
01231 /* L250: */
01232                         }
01233                     }
01234                     if (ipackg == 6) {
01235                         ipackg = ipack;
01236                     } else {
01237                         ipackg = 0;
01238                     }
01239                 }
01240             } else {
01241 
01242 /*              Bottom-Up -- Generate Lower triangle only */
01243 
01244                 if (ipack >= 5) {
01245                     ipackg = 5;
01246                     if (ipack == 6) {
01247                         ioffg = 1;
01248                     }
01249                 } else {
01250                     ipackg = 2;
01251                 }
01252 
01253                 i__1 = mnmin;
01254                 for (j = 1; j <= i__1; ++j) {
01255                     i__4 = (1 - iskew) * j + ioffg + j * a_dim1;
01256                     i__2 = j;
01257                     z__1.r = d__[i__2], z__1.i = 0.;
01258                     a[i__4].r = z__1.r, a[i__4].i = z__1.i;
01259 /* L260: */
01260                 }
01261 
01262                 i__1 = uub;
01263                 for (k = 1; k <= i__1; ++k) {
01264                     for (jc = *n - 1; jc >= 1; --jc) {
01265 /* Computing MIN */
01266                         i__4 = *n + 1 - jc, i__2 = k + 2;
01267                         il = min(i__4,i__2);
01268                         extra.r = 0., extra.i = 0.;
01269                         i__4 = (1 - iskew) * jc + 1 + ioffg + jc * a_dim1;
01270                         ctemp.r = a[i__4].r, ctemp.i = a[i__4].i;
01271                         angle = dlarnd_(&c__1, &iseed[1]) * 
01272                                 6.2831853071795864769252867663;
01273                         d__1 = cos(angle);
01274                         zlarnd_(&z__2, &c__5, &iseed[1]);
01275                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
01276                         c__.r = z__1.r, c__.i = z__1.i;
01277                         d__1 = sin(angle);
01278                         zlarnd_(&z__2, &c__5, &iseed[1]);
01279                         z__1.r = d__1 * z__2.r, z__1.i = d__1 * z__2.i;
01280                         s.r = z__1.r, s.i = z__1.i;
01281                         if (zsym) {
01282                             ct.r = c__.r, ct.i = c__.i;
01283                             st.r = s.r, st.i = s.i;
01284                         } else {
01285                             d_cnjg(&z__1, &ctemp);
01286                             ctemp.r = z__1.r, ctemp.i = z__1.i;
01287                             d_cnjg(&z__1, &c__);
01288                             ct.r = z__1.r, ct.i = z__1.i;
01289                             d_cnjg(&z__1, &s);
01290                             st.r = z__1.r, st.i = z__1.i;
01291                         }
01292                         L__1 = *n - jc > k;
01293                         zlarot_(&c_false, &c_true, &L__1, &il, &c__, &s, &a[(
01294                                 1 - iskew) * jc + ioffg + jc * a_dim1], &ilda, 
01295                                  &ctemp, &extra);
01296 /* Computing MAX */
01297                         i__4 = 1, i__2 = jc - k + 1;
01298                         icol = max(i__4,i__2);
01299                         i__4 = jc + 2 - icol;
01300                         zlarot_(&c_true, &c_false, &c_true, &i__4, &ct, &st, &
01301                                 a[jc - iskew * icol + ioffg + icol * a_dim1], 
01302                                 &ilda, &dummy, &ctemp);
01303 
01304 /*                    Chase EXTRA back down the matrix */
01305 
01306                         icol = jc;
01307                         i__4 = *n - 1;
01308                         i__2 = k;
01309                         for (jch = jc + k; i__2 < 0 ? jch >= i__4 : jch <= 
01310                                 i__4; jch += i__2) {
01311                             zlartg_(&a[jch - iskew * icol + ioffg + icol * 
01312                                     a_dim1], &extra, &realc, &s, &dummy);
01313                             zlarnd_(&z__1, &c__5, &iseed[1]);
01314                             dummy.r = z__1.r, dummy.i = z__1.i;
01315                             z__1.r = realc * dummy.r, z__1.i = realc * 
01316                                     dummy.i;
01317                             c__.r = z__1.r, c__.i = z__1.i;
01318                             z__1.r = s.r * dummy.r - s.i * dummy.i, z__1.i = 
01319                                     s.r * dummy.i + s.i * dummy.r;
01320                             s.r = z__1.r, s.i = z__1.i;
01321                             i__3 = (1 - iskew) * jch + 1 + ioffg + jch * 
01322                                     a_dim1;
01323                             ctemp.r = a[i__3].r, ctemp.i = a[i__3].i;
01324                             if (zsym) {
01325                                 ct.r = c__.r, ct.i = c__.i;
01326                                 st.r = s.r, st.i = s.i;
01327                             } else {
01328                                 d_cnjg(&z__1, &ctemp);
01329                                 ctemp.r = z__1.r, ctemp.i = z__1.i;
01330                                 d_cnjg(&z__1, &c__);
01331                                 ct.r = z__1.r, ct.i = z__1.i;
01332                                 d_cnjg(&z__1, &s);
01333                                 st.r = z__1.r, st.i = z__1.i;
01334                             }
01335                             i__3 = k + 2;
01336                             zlarot_(&c_true, &c_true, &c_true, &i__3, &c__, &
01337                                     s, &a[jch - iskew * icol + ioffg + icol * 
01338                                     a_dim1], &ilda, &extra, &ctemp);
01339 /* Computing MIN */
01340                             i__3 = *n + 1 - jch, i__5 = k + 2;
01341                             il = min(i__3,i__5);
01342                             extra.r = 0., extra.i = 0.;
01343                             L__1 = *n - jch > k;
01344                             zlarot_(&c_false, &c_true, &L__1, &il, &ct, &st, &
01345                                     a[(1 - iskew) * jch + ioffg + jch * 
01346                                     a_dim1], &ilda, &ctemp, &extra);
01347                             icol = jch;
01348 /* L270: */
01349                         }
01350 /* L280: */
01351                     }
01352 /* L290: */
01353                 }
01354 
01355 /*              If we need upper triangle, copy from lower. Note that */
01356 /*              the order of copying is chosen to work for 'b' -> 'q' */
01357 
01358                 if (ipack != ipackg && ipack != 4) {
01359                     for (jc = *n; jc >= 1; --jc) {
01360                         irow = ioffst - iskew * jc;
01361                         if (zsym) {
01362 /* Computing MAX */
01363                             i__2 = 1, i__4 = jc - uub;
01364                             i__1 = max(i__2,i__4);
01365                             for (jr = jc; jr >= i__1; --jr) {
01366                                 i__2 = jr + irow + jc * a_dim1;
01367                                 i__4 = jc - iskew * jr + ioffg + jr * a_dim1;
01368                                 a[i__2].r = a[i__4].r, a[i__2].i = a[i__4].i;
01369 /* L300: */
01370                             }
01371                         } else {
01372 /* Computing MAX */
01373                             i__2 = 1, i__4 = jc - uub;
01374                             i__1 = max(i__2,i__4);
01375                             for (jr = jc; jr >= i__1; --jr) {
01376                                 i__2 = jr + irow + jc * a_dim1;
01377                                 d_cnjg(&z__1, &a[jc - iskew * jr + ioffg + jr 
01378                                         * a_dim1]);
01379                                 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
01380 /* L310: */
01381                             }
01382                         }
01383 /* L320: */
01384                     }
01385                     if (ipack == 6) {
01386                         i__1 = uub;
01387                         for (jc = 1; jc <= i__1; ++jc) {
01388                             i__2 = uub + 1 - jc;
01389                             for (jr = 1; jr <= i__2; ++jr) {
01390                                 i__4 = jr + jc * a_dim1;
01391                                 a[i__4].r = 0., a[i__4].i = 0.;
01392 /* L330: */
01393                             }
01394 /* L340: */
01395                         }
01396                     }
01397                     if (ipackg == 5) {
01398                         ipackg = ipack;
01399                     } else {
01400                         ipackg = 0;
01401                     }
01402                 }
01403             }
01404 
01405 /*           Ensure that the diagonal is real if Hermitian */
01406 
01407             if (! zsym) {
01408                 i__1 = *n;
01409                 for (jc = 1; jc <= i__1; ++jc) {
01410                     irow = ioffst + (1 - iskew) * jc;
01411                     i__2 = irow + jc * a_dim1;
01412                     i__4 = irow + jc * a_dim1;
01413                     d__1 = a[i__4].r;
01414                     z__1.r = d__1, z__1.i = 0.;
01415                     a[i__2].r = z__1.r, a[i__2].i = z__1.i;
01416 /* L350: */
01417                 }
01418             }
01419 
01420         }
01421 
01422     } else {
01423 
01424 /*        4)      Generate Banded Matrix by first */
01425 /*                Rotating by random Unitary matrices, */
01426 /*                then reducing the bandwidth using Householder */
01427 /*                transformations. */
01428 
01429 /*                Note: we should get here only if LDA .ge. N */
01430 
01431         if (isym == 1) {
01432 
01433 /*           Non-symmetric -- A = U D V */
01434 
01435             zlagge_(&mr, &nc, &llb, &uub, &d__[1], &a[a_offset], lda, &iseed[
01436                     1], &work[1], &iinfo);
01437         } else {
01438 
01439 /*           Symmetric -- A = U D U' or */
01440 /*           Hermitian -- A = U D U* */
01441 
01442             if (zsym) {
01443                 zlagsy_(m, &llb, &d__[1], &a[a_offset], lda, &iseed[1], &work[
01444                         1], &iinfo);
01445             } else {
01446                 zlaghe_(m, &llb, &d__[1], &a[a_offset], lda, &iseed[1], &work[
01447                         1], &iinfo);
01448             }
01449         }
01450 
01451         if (iinfo != 0) {
01452             *info = 3;
01453             return 0;
01454         }
01455     }
01456 
01457 /*     5)      Pack the matrix */
01458 
01459     if (ipack != ipackg) {
01460         if (ipack == 1) {
01461 
01462 /*           'U' -- Upper triangular, not packed */
01463 
01464             i__1 = *m;
01465             for (j = 1; j <= i__1; ++j) {
01466                 i__2 = *m;
01467                 for (i__ = j + 1; i__ <= i__2; ++i__) {
01468                     i__4 = i__ + j * a_dim1;
01469                     a[i__4].r = 0., a[i__4].i = 0.;
01470 /* L360: */
01471                 }
01472 /* L370: */
01473             }
01474 
01475         } else if (ipack == 2) {
01476 
01477 /*           'L' -- Lower triangular, not packed */
01478 
01479             i__1 = *m;
01480             for (j = 2; j <= i__1; ++j) {
01481                 i__2 = j - 1;
01482                 for (i__ = 1; i__ <= i__2; ++i__) {
01483                     i__4 = i__ + j * a_dim1;
01484                     a[i__4].r = 0., a[i__4].i = 0.;
01485 /* L380: */
01486                 }
01487 /* L390: */
01488             }
01489 
01490         } else if (ipack == 3) {
01491 
01492 /*           'C' -- Upper triangle packed Columnwise. */
01493 
01494             icol = 1;
01495             irow = 0;
01496             i__1 = *m;
01497             for (j = 1; j <= i__1; ++j) {
01498                 i__2 = j;
01499                 for (i__ = 1; i__ <= i__2; ++i__) {
01500                     ++irow;
01501                     if (irow > *lda) {
01502                         irow = 1;
01503                         ++icol;
01504                     }
01505                     i__4 = irow + icol * a_dim1;
01506                     i__3 = i__ + j * a_dim1;
01507                     a[i__4].r = a[i__3].r, a[i__4].i = a[i__3].i;
01508 /* L400: */
01509                 }
01510 /* L410: */
01511             }
01512 
01513         } else if (ipack == 4) {
01514 
01515 /*           'R' -- Lower triangle packed Columnwise. */
01516 
01517             icol = 1;
01518             irow = 0;
01519             i__1 = *m;
01520             for (j = 1; j <= i__1; ++j) {
01521                 i__2 = *m;
01522                 for (i__ = j; i__ <= i__2; ++i__) {
01523                     ++irow;
01524                     if (irow > *lda) {
01525                         irow = 1;
01526                         ++icol;
01527                     }
01528                     i__4 = irow + icol * a_dim1;
01529                     i__3 = i__ + j * a_dim1;
01530                     a[i__4].r = a[i__3].r, a[i__4].i = a[i__3].i;
01531 /* L420: */
01532                 }
01533 /* L430: */
01534             }
01535 
01536         } else if (ipack >= 5) {
01537 
01538 /*           'B' -- The lower triangle is packed as a band matrix. */
01539 /*           'Q' -- The upper triangle is packed as a band matrix. */
01540 /*           'Z' -- The whole matrix is packed as a band matrix. */
01541 
01542             if (ipack == 5) {
01543                 uub = 0;
01544             }
01545             if (ipack == 6) {
01546                 llb = 0;
01547             }
01548 
01549             i__1 = uub;
01550             for (j = 1; j <= i__1; ++j) {
01551 /* Computing MIN */
01552                 i__2 = j + llb;
01553                 for (i__ = min(i__2,*m); i__ >= 1; --i__) {
01554                     i__2 = i__ - j + uub + 1 + j * a_dim1;
01555                     i__4 = i__ + j * a_dim1;
01556                     a[i__2].r = a[i__4].r, a[i__2].i = a[i__4].i;
01557 /* L440: */
01558                 }
01559 /* L450: */
01560             }
01561 
01562             i__1 = *n;
01563             for (j = uub + 2; j <= i__1; ++j) {
01564 /* Computing MIN */
01565                 i__4 = j + llb;
01566                 i__2 = min(i__4,*m);
01567                 for (i__ = j - uub; i__ <= i__2; ++i__) {
01568                     i__4 = i__ - j + uub + 1 + j * a_dim1;
01569                     i__3 = i__ + j * a_dim1;
01570                     a[i__4].r = a[i__3].r, a[i__4].i = a[i__3].i;
01571 /* L460: */
01572                 }
01573 /* L470: */
01574             }
01575         }
01576 
01577 /*        If packed, zero out extraneous elements. */
01578 
01579 /*        Symmetric/Triangular Packed -- */
01580 /*        zero out everything after A(IROW,ICOL) */
01581 
01582         if (ipack == 3 || ipack == 4) {
01583             i__1 = *m;
01584             for (jc = icol; jc <= i__1; ++jc) {
01585                 i__2 = *lda;
01586                 for (jr = irow + 1; jr <= i__2; ++jr) {
01587                     i__4 = jr + jc * a_dim1;
01588                     a[i__4].r = 0., a[i__4].i = 0.;
01589 /* L480: */
01590                 }
01591                 irow = 0;
01592 /* L490: */
01593             }
01594 
01595         } else if (ipack >= 5) {
01596 
01597 /*           Packed Band -- */
01598 /*              1st row is now in A( UUB+2-j, j), zero above it */
01599 /*              m-th row is now in A( M+UUB-j,j), zero below it */
01600 /*              last non-zero diagonal is now in A( UUB+LLB+1,j ), */
01601 /*                 zero below it, too. */
01602 
01603             ir1 = uub + llb + 2;
01604             ir2 = uub + *m + 2;
01605             i__1 = *n;
01606             for (jc = 1; jc <= i__1; ++jc) {
01607                 i__2 = uub + 1 - jc;
01608                 for (jr = 1; jr <= i__2; ++jr) {
01609                     i__4 = jr + jc * a_dim1;
01610                     a[i__4].r = 0., a[i__4].i = 0.;
01611 /* L500: */
01612                 }
01613 /* Computing MAX */
01614 /* Computing MIN */
01615                 i__3 = ir1, i__5 = ir2 - jc;
01616                 i__2 = 1, i__4 = min(i__3,i__5);
01617                 i__6 = *lda;
01618                 for (jr = max(i__2,i__4); jr <= i__6; ++jr) {
01619                     i__2 = jr + jc * a_dim1;
01620                     a[i__2].r = 0., a[i__2].i = 0.;
01621 /* L510: */
01622                 }
01623 /* L520: */
01624             }
01625         }
01626     }
01627 
01628     return 0;
01629 
01630 /*     End of ZLATMS */
01631 
01632 } /* zlatms_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:42