clatmt.c
Go to the documentation of this file.
00001 /* clatmt.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 complex c_b1 = {0.f,0.f};
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 clatmt_(integer *m, integer *n, char *dist, integer *
00025         iseed, char *sym, real *d__, integer *mode, real *cond, real *dmax__, 
00026         integer *rank, integer *kl, integer *ku, char *pack, complex *a, 
00027         integer *lda, complex *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     real r__1, r__2, r__3;
00032     complex q__1, q__2, q__3;
00033     logical L__1;
00034 
00035     /* Builtin functions */
00036     double cos(doublereal), sin(doublereal);
00037     void r_cnjg(complex *, complex *);
00038 
00039     /* Local variables */
00040     complex c__;
00041     integer i__, j, k;
00042     complex s;
00043     integer ic, jc, nc, il;
00044     complex ct;
00045     integer ir, jr, mr;
00046     complex st;
00047     integer ir1, ir2, jch, llb, jkl, jku, uub, ilda, icol;
00048     real temp;
00049     logical csym;
00050     integer irow, isym;
00051     real alpha, angle, realc;
00052     integer ipack, ioffg;
00053     extern logical lsame_(char *, char *);
00054     integer iinfo;
00055     extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
00056     complex ctemp;
00057     integer idist, mnmin;
00058     complex extra;
00059     integer iskew;
00060     complex dummy;
00061     extern /* Subroutine */ int slatm7_(integer *, real *, integer *, integer 
00062             *, integer *, real *, integer *, integer *, integer *), clagge_(
00063             integer *, integer *, integer *, integer *, real *, complex *, 
00064             integer *, integer *, complex *, integer *), claghe_(integer *, 
00065             integer *, real *, complex *, integer *, integer *, complex *, 
00066             integer *);
00067     integer iendch, ipackg;
00068     extern /* Complex */ VOID clarnd_(complex *, integer *, integer *);
00069     integer minlda;
00070     extern /* Subroutine */ int claset_(char *, integer *, integer *, complex 
00071             *, complex *, complex *, integer *), clartg_(complex *, 
00072             complex *, real *, complex *, complex *), xerbla_(char *, integer 
00073             *), clagsy_(integer *, integer *, real *, complex *, 
00074             integer *, integer *, complex *, integer *);
00075     extern doublereal slarnd_(integer *, integer *);
00076     extern /* Subroutine */ int clarot_(logical *, logical *, logical *, 
00077             integer *, complex *, complex *, complex *, integer *, complex *, 
00078             complex *);
00079     integer ioffst, irsign;
00080     logical givens, iltemp, ilextr, topdwn;
00081     integer isympk;
00082 
00083 
00084 /*  -- LAPACK test routine (version 3.1) -- */
00085 /*     Craig Lucas, University of Manchester / NAG Ltd. */
00086 /*     October, 2008 */
00087 
00088 /*     .. Scalar Arguments .. */
00089 /*     .. */
00090 /*     .. Array Arguments .. */
00091 /*     .. */
00092 
00093 /*  Purpose */
00094 /*  ======= */
00095 
00096 /*     CLATMT generates random matrices with specified singular values */
00097 /*     (or hermitian with specified eigenvalues) */
00098 /*     for testing LAPACK programs. */
00099 
00100 /*     CLATMT operates by applying the following sequence of */
00101 /*     operations: */
00102 
00103 /*       Set the diagonal to D, where D may be input or */
00104 /*          computed according to MODE, COND, DMAX, and SYM */
00105 /*          as described below. */
00106 
00107 /*       Generate a matrix with the appropriate band structure, by one */
00108 /*          of two methods: */
00109 
00110 /*       Method A: */
00111 /*           Generate a dense M x N matrix by multiplying D on the left */
00112 /*               and the right by random unitary matrices, then: */
00113 
00114 /*           Reduce the bandwidth according to KL and KU, using */
00115 /*               Householder transformations. */
00116 
00117 /*       Method B: */
00118 /*           Convert the bandwidth-0 (i.e., diagonal) matrix to a */
00119 /*               bandwidth-1 matrix using Givens rotations, "chasing" */
00120 /*               out-of-band elements back, much as in QR; then convert */
00121 /*               the bandwidth-1 to a bandwidth-2 matrix, etc.  Note */
00122 /*               that for reasonably small bandwidths (relative to M and */
00123 /*               N) this requires less storage, as a dense matrix is not */
00124 /*               generated.  Also, for hermitian or symmetric matrices, */
00125 /*               only one triangle is generated. */
00126 
00127 /*       Method A is chosen if the bandwidth is a large fraction of the */
00128 /*           order of the matrix, and LDA is at least M (so a dense */
00129 /*           matrix can be stored.)  Method B is chosen if the bandwidth */
00130 /*           is small (< 1/2 N for hermitian or symmetric, < .3 N+M for */
00131 /*           non-symmetric), or LDA is less than M and not less than the */
00132 /*           bandwidth. */
00133 
00134 /*       Pack the matrix if desired. Options specified by PACK are: */
00135 /*          no packing */
00136 /*          zero out upper half (if hermitian) */
00137 /*          zero out lower half (if hermitian) */
00138 /*          store the upper half columnwise (if hermitian or upper */
00139 /*                triangular) */
00140 /*          store the lower half columnwise (if hermitian or lower */
00141 /*                triangular) */
00142 /*          store the lower triangle in banded format (if hermitian or */
00143 /*                lower triangular) */
00144 /*          store the upper triangle in banded format (if hermitian or */
00145 /*                upper triangular) */
00146 /*          store the entire matrix in banded format */
00147 /*       If Method B is chosen, and band format is specified, then the */
00148 /*          matrix will be generated in the band format, so no repacking */
00149 /*          will be necessary. */
00150 
00151 /*  Arguments */
00152 /*  ========= */
00153 
00154 /*  M      - INTEGER */
00155 /*           The number of rows of A. Not modified. */
00156 
00157 /*  N      - INTEGER */
00158 /*           The number of columns of A. N must equal M if the matrix */
00159 /*           is symmetric or hermitian (i.e., if SYM is not 'N') */
00160 /*           Not modified. */
00161 
00162 /*  DIST   - CHARACTER*1 */
00163 /*           On entry, DIST specifies the type of distribution to be used */
00164 /*           to generate the random eigen-/singular values. */
00165 /*           'U' => UNIFORM( 0, 1 )  ( 'U' for uniform ) */
00166 /*           'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) */
00167 /*           'N' => NORMAL( 0, 1 )   ( 'N' for normal ) */
00168 /*           Not modified. */
00169 
00170 /*  ISEED  - INTEGER array, dimension ( 4 ) */
00171 /*           On entry ISEED specifies the seed of the random number */
00172 /*           generator. They should lie between 0 and 4095 inclusive, */
00173 /*           and ISEED(4) should be odd. The random number generator */
00174 /*           uses a linear congruential sequence limited to small */
00175 /*           integers, and so should produce machine independent */
00176 /*           random numbers. The values of ISEED are changed on */
00177 /*           exit, and can be used in the next call to CLATMT */
00178 /*           to continue the same random number sequence. */
00179 /*           Changed on exit. */
00180 
00181 /*  SYM    - CHARACTER*1 */
00182 /*           If SYM='H', the generated matrix is hermitian, with */
00183 /*             eigenvalues specified by D, COND, MODE, and DMAX; they */
00184 /*             may be positive, negative, or zero. */
00185 /*           If SYM='P', the generated matrix is hermitian, with */
00186 /*             eigenvalues (= singular values) specified by D, COND, */
00187 /*             MODE, and DMAX; they will not be negative. */
00188 /*           If SYM='N', the generated matrix is nonsymmetric, with */
00189 /*             singular values specified by D, COND, MODE, and DMAX; */
00190 /*             they will not be negative. */
00191 /*           If SYM='S', the generated matrix is (complex) symmetric, */
00192 /*             with singular values specified by D, COND, MODE, and */
00193 /*             DMAX; they will not be negative. */
00194 /*           Not modified. */
00195 
00196 /*  D      - REAL array, dimension ( MIN( M, N ) ) */
00197 /*           This array is used to specify the singular values or */
00198 /*           eigenvalues of A (see SYM, above.)  If MODE=0, then D is */
00199 /*           assumed to contain the singular/eigenvalues, otherwise */
00200 /*           they will be computed according to MODE, COND, and DMAX, */
00201 /*           and placed in D. */
00202 /*           Modified if MODE is nonzero. */
00203 
00204 /*  MODE   - INTEGER */
00205 /*           On entry this describes how the singular/eigenvalues are to */
00206 /*           be specified: */
00207 /*           MODE = 0 means use D as input */
00208 /*           MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND */
00209 /*           MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND */
00210 /*           MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) */
00211 /*           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) */
00212 /*           MODE = 5 sets D to random numbers in the range */
00213 /*                    ( 1/COND , 1 ) such that their logarithms */
00214 /*                    are uniformly distributed. */
00215 /*           MODE = 6 set D to random numbers from same distribution */
00216 /*                    as the rest of the matrix. */
00217 /*           MODE < 0 has the same meaning as ABS(MODE), except that */
00218 /*              the order of the elements of D is reversed. */
00219 /*           Thus if MODE is positive, D has entries ranging from */
00220 /*              1 to 1/COND, if negative, from 1/COND to 1, */
00221 /*           If SYM='H', and MODE is neither 0, 6, nor -6, then */
00222 /*              the elements of D will also be multiplied by a random */
00223 /*              sign (i.e., +1 or -1.) */
00224 /*           Not modified. */
00225 
00226 /*  COND   - REAL */
00227 /*           On entry, this is used as described under MODE above. */
00228 /*           If used, it must be >= 1. Not modified. */
00229 
00230 /*  DMAX   - REAL */
00231 /*           If MODE is neither -6, 0 nor 6, the contents of D, as */
00232 /*           computed according to MODE and COND, will be scaled by */
00233 /*           DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or */
00234 /*           singular value (which is to say the norm) will be abs(DMAX). */
00235 /*           Note that DMAX need not be positive: if DMAX is negative */
00236 /*           (or zero), D will be scaled by a negative number (or zero). */
00237 /*           Not modified. */
00238 
00239 /*  RANK   - INTEGER */
00240 /*           The rank of matrix to be generated for modes 1,2,3 only. */
00241 /*           D( RANK+1:N ) = 0. */
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 CLATMT differ only in the PACK parameter, */
00289 /*           they will generate mathematically equivalent matrices. */
00290 /*           Not modified. */
00291 
00292 /*  A      - COMPLEX 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 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 SLATM7 */
00337 /*            2  => Cannot scale to DMAX (max. sing. value is 0) */
00338 /*            3  => Error return from CLAGGE, 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         csym = FALSE_;
00392     } else if (lsame_(sym, "P")) {
00393         isym = 2;
00394         irsign = 0;
00395         csym = FALSE_;
00396     } else if (lsame_(sym, "S")) {
00397         isym = 2;
00398         irsign = 0;
00399         csym = TRUE_;
00400     } else if (lsame_(sym, "H")) {
00401         isym = 2;
00402         irsign = 1;
00403         csym = 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 ((real) (llb + uub) < (real) max(i__1,i__2) * .3f) {
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.f) {
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_("CLATMT", &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 /* L100: */
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     slatm7_(mode, cond, &irsign, &idist, &iseed[1], &d__[1], &mnmin, rank, &
00530             iinfo);
00531     if (iinfo != 0) {
00532         *info = 1;
00533         return 0;
00534     }
00535 
00536 /*     Choose Top-Down if D is (apparently) increasing, */
00537 /*     Bottom-Up if D is (apparently) decreasing. */
00538 
00539     if (dabs(d__[1]) <= (r__1 = d__[*rank], dabs(r__1))) {
00540         topdwn = TRUE_;
00541     } else {
00542         topdwn = FALSE_;
00543     }
00544 
00545     if (*mode != 0 && abs(*mode) != 6) {
00546 
00547 /*        Scale by DMAX */
00548 
00549         temp = dabs(d__[1]);
00550         i__1 = *rank;
00551         for (i__ = 2; i__ <= i__1; ++i__) {
00552 /* Computing MAX */
00553             r__2 = temp, r__3 = (r__1 = d__[i__], dabs(r__1));
00554             temp = dmax(r__2,r__3);
00555 /* L110: */
00556         }
00557 
00558         if (temp > 0.f) {
00559             alpha = *dmax__ / temp;
00560         } else {
00561             *info = 2;
00562             return 0;
00563         }
00564 
00565         sscal_(rank, &alpha, &d__[1], &c__1);
00566 
00567     }
00568 
00569     claset_("Full", lda, n, &c_b1, &c_b1, &a[a_offset], lda);
00570 
00571 /*     3)      Generate Banded Matrix using Givens rotations. */
00572 /*             Also the special case of UUB=LLB=0 */
00573 
00574 /*               Compute Addressing constants to cover all */
00575 /*               storage formats.  Whether GE, HE, SY, GB, HB, or SB, */
00576 /*               upper or lower triangle or both, */
00577 /*               the (i,j)-th element is in */
00578 /*               A( i - ISKEW*j + IOFFST, j ) */
00579 
00580     if (ipack > 4) {
00581         ilda = *lda - 1;
00582         iskew = 1;
00583         if (ipack > 5) {
00584             ioffst = uub + 1;
00585         } else {
00586             ioffst = 1;
00587         }
00588     } else {
00589         ilda = *lda;
00590         iskew = 0;
00591         ioffst = 0;
00592     }
00593 
00594 /*     IPACKG is the format that the matrix is generated in. If this is */
00595 /*     different from IPACK, then the matrix must be repacked at the */
00596 /*     end.  It also signals how to compute the norm, for scaling. */
00597 
00598     ipackg = 0;
00599 
00600 /*     Diagonal Matrix -- We are done, unless it */
00601 /*     is to be stored HP/SP/PP/TP (PACK='R' or 'C') */
00602 
00603     if (llb == 0 && uub == 0) {
00604         i__1 = mnmin;
00605         for (j = 1; j <= i__1; ++j) {
00606             i__2 = (1 - iskew) * j + ioffst + j * a_dim1;
00607             i__3 = j;
00608             q__1.r = d__[i__3], q__1.i = 0.f;
00609             a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00610 /* L120: */
00611         }
00612 
00613         if (ipack <= 2 || ipack >= 5) {
00614             ipackg = ipack;
00615         }
00616 
00617     } else if (givens) {
00618 
00619 /*        Check whether to use Givens rotations, */
00620 /*        Householder transformations, or nothing. */
00621 
00622         if (isym == 1) {
00623 
00624 /*           Non-symmetric -- A = U D V */
00625 
00626             if (ipack > 4) {
00627                 ipackg = ipack;
00628             } else {
00629                 ipackg = 0;
00630             }
00631 
00632             i__1 = mnmin;
00633             for (j = 1; j <= i__1; ++j) {
00634                 i__2 = (1 - iskew) * j + ioffst + j * a_dim1;
00635                 i__3 = j;
00636                 q__1.r = d__[i__3], q__1.i = 0.f;
00637                 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00638 /* L130: */
00639             }
00640 
00641             if (topdwn) {
00642                 jkl = 0;
00643                 i__1 = uub;
00644                 for (jku = 1; jku <= i__1; ++jku) {
00645 
00646 /*                 Transform from bandwidth JKL, JKU-1 to JKL, JKU */
00647 
00648 /*                 Last row actually rotated is M */
00649 /*                 Last column actually rotated is MIN( M+JKU, N ) */
00650 
00651 /* Computing MIN */
00652                     i__3 = *m + jku;
00653                     i__2 = min(i__3,*n) + jkl - 1;
00654                     for (jr = 1; jr <= i__2; ++jr) {
00655                         extra.r = 0.f, extra.i = 0.f;
00656                         angle = slarnd_(&c__1, &iseed[1]) * 
00657                                 6.2831853071795864769252867663f;
00658                         r__1 = cos(angle);
00659                         clarnd_(&q__2, &c__5, &iseed[1]);
00660                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00661                         c__.r = q__1.r, c__.i = q__1.i;
00662                         r__1 = sin(angle);
00663                         clarnd_(&q__2, &c__5, &iseed[1]);
00664                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00665                         s.r = q__1.r, s.i = q__1.i;
00666 /* Computing MAX */
00667                         i__3 = 1, i__4 = jr - jkl;
00668                         icol = max(i__3,i__4);
00669                         if (jr < *m) {
00670 /* Computing MIN */
00671                             i__3 = *n, i__4 = jr + jku;
00672                             il = min(i__3,i__4) + 1 - icol;
00673                             L__1 = jr > jkl;
00674                             clarot_(&c_true, &L__1, &c_false, &il, &c__, &s, &
00675                                     a[jr - iskew * icol + ioffst + icol * 
00676                                     a_dim1], &ilda, &extra, &dummy);
00677                         }
00678 
00679 /*                    Chase "EXTRA" back up */
00680 
00681                         ir = jr;
00682                         ic = icol;
00683                         i__3 = -jkl - jku;
00684                         for (jch = jr - jkl; i__3 < 0 ? jch >= 1 : jch <= 1; 
00685                                 jch += i__3) {
00686                             if (ir < *m) {
00687                                 clartg_(&a[ir + 1 - iskew * (ic + 1) + ioffst 
00688                                         + (ic + 1) * a_dim1], &extra, &realc, 
00689                                         &s, &dummy);
00690                                 clarnd_(&q__1, &c__5, &iseed[1]);
00691                                 dummy.r = q__1.r, dummy.i = q__1.i;
00692                                 q__2.r = realc * dummy.r, q__2.i = realc * 
00693                                         dummy.i;
00694                                 r_cnjg(&q__1, &q__2);
00695                                 c__.r = q__1.r, c__.i = q__1.i;
00696                                 q__3.r = -s.r, q__3.i = -s.i;
00697                                 q__2.r = q__3.r * dummy.r - q__3.i * dummy.i, 
00698                                         q__2.i = q__3.r * dummy.i + q__3.i * 
00699                                         dummy.r;
00700                                 r_cnjg(&q__1, &q__2);
00701                                 s.r = q__1.r, s.i = q__1.i;
00702                             }
00703 /* Computing MAX */
00704                             i__4 = 1, i__5 = jch - jku;
00705                             irow = max(i__4,i__5);
00706                             il = ir + 2 - irow;
00707                             ctemp.r = 0.f, ctemp.i = 0.f;
00708                             iltemp = jch > jku;
00709                             clarot_(&c_false, &iltemp, &c_true, &il, &c__, &s, 
00710                                      &a[irow - iskew * ic + ioffst + ic * 
00711                                     a_dim1], &ilda, &ctemp, &extra);
00712                             if (iltemp) {
00713                                 clartg_(&a[irow + 1 - iskew * (ic + 1) + 
00714                                         ioffst + (ic + 1) * a_dim1], &ctemp, &
00715                                         realc, &s, &dummy);
00716                                 clarnd_(&q__1, &c__5, &iseed[1]);
00717                                 dummy.r = q__1.r, dummy.i = q__1.i;
00718                                 q__2.r = realc * dummy.r, q__2.i = realc * 
00719                                         dummy.i;
00720                                 r_cnjg(&q__1, &q__2);
00721                                 c__.r = q__1.r, c__.i = q__1.i;
00722                                 q__3.r = -s.r, q__3.i = -s.i;
00723                                 q__2.r = q__3.r * dummy.r - q__3.i * dummy.i, 
00724                                         q__2.i = q__3.r * dummy.i + q__3.i * 
00725                                         dummy.r;
00726                                 r_cnjg(&q__1, &q__2);
00727                                 s.r = q__1.r, s.i = q__1.i;
00728 
00729 /* Computing MAX */
00730                                 i__4 = 1, i__5 = jch - jku - jkl;
00731                                 icol = max(i__4,i__5);
00732                                 il = ic + 2 - icol;
00733                                 extra.r = 0.f, extra.i = 0.f;
00734                                 L__1 = jch > jku + jkl;
00735                                 clarot_(&c_true, &L__1, &c_true, &il, &c__, &
00736                                         s, &a[irow - iskew * icol + ioffst + 
00737                                         icol * a_dim1], &ilda, &extra, &ctemp)
00738                                         ;
00739                                 ic = icol;
00740                                 ir = irow;
00741                             }
00742 /* L140: */
00743                         }
00744 /* L150: */
00745                     }
00746 /* L160: */
00747                 }
00748 
00749                 jku = uub;
00750                 i__1 = llb;
00751                 for (jkl = 1; jkl <= i__1; ++jkl) {
00752 
00753 /*                 Transform from bandwidth JKL-1, JKU to JKL, JKU */
00754 
00755 /* Computing MIN */
00756                     i__3 = *n + jkl;
00757                     i__2 = min(i__3,*m) + jku - 1;
00758                     for (jc = 1; jc <= i__2; ++jc) {
00759                         extra.r = 0.f, extra.i = 0.f;
00760                         angle = slarnd_(&c__1, &iseed[1]) * 
00761                                 6.2831853071795864769252867663f;
00762                         r__1 = cos(angle);
00763                         clarnd_(&q__2, &c__5, &iseed[1]);
00764                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00765                         c__.r = q__1.r, c__.i = q__1.i;
00766                         r__1 = sin(angle);
00767                         clarnd_(&q__2, &c__5, &iseed[1]);
00768                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00769                         s.r = q__1.r, s.i = q__1.i;
00770 /* Computing MAX */
00771                         i__3 = 1, i__4 = jc - jku;
00772                         irow = max(i__3,i__4);
00773                         if (jc < *n) {
00774 /* Computing MIN */
00775                             i__3 = *m, i__4 = jc + jkl;
00776                             il = min(i__3,i__4) + 1 - irow;
00777                             L__1 = jc > jku;
00778                             clarot_(&c_false, &L__1, &c_false, &il, &c__, &s, 
00779                                     &a[irow - iskew * jc + ioffst + jc * 
00780                                     a_dim1], &ilda, &extra, &dummy);
00781                         }
00782 
00783 /*                    Chase "EXTRA" back up */
00784 
00785                         ic = jc;
00786                         ir = irow;
00787                         i__3 = -jkl - jku;
00788                         for (jch = jc - jku; i__3 < 0 ? jch >= 1 : jch <= 1; 
00789                                 jch += i__3) {
00790                             if (ic < *n) {
00791                                 clartg_(&a[ir + 1 - iskew * (ic + 1) + ioffst 
00792                                         + (ic + 1) * a_dim1], &extra, &realc, 
00793                                         &s, &dummy);
00794                                 clarnd_(&q__1, &c__5, &iseed[1]);
00795                                 dummy.r = q__1.r, dummy.i = q__1.i;
00796                                 q__2.r = realc * dummy.r, q__2.i = realc * 
00797                                         dummy.i;
00798                                 r_cnjg(&q__1, &q__2);
00799                                 c__.r = q__1.r, c__.i = q__1.i;
00800                                 q__3.r = -s.r, q__3.i = -s.i;
00801                                 q__2.r = q__3.r * dummy.r - q__3.i * dummy.i, 
00802                                         q__2.i = q__3.r * dummy.i + q__3.i * 
00803                                         dummy.r;
00804                                 r_cnjg(&q__1, &q__2);
00805                                 s.r = q__1.r, s.i = q__1.i;
00806                             }
00807 /* Computing MAX */
00808                             i__4 = 1, i__5 = jch - jkl;
00809                             icol = max(i__4,i__5);
00810                             il = ic + 2 - icol;
00811                             ctemp.r = 0.f, ctemp.i = 0.f;
00812                             iltemp = jch > jkl;
00813                             clarot_(&c_true, &iltemp, &c_true, &il, &c__, &s, 
00814                                     &a[ir - iskew * icol + ioffst + icol * 
00815                                     a_dim1], &ilda, &ctemp, &extra);
00816                             if (iltemp) {
00817                                 clartg_(&a[ir + 1 - iskew * (icol + 1) + 
00818                                         ioffst + (icol + 1) * a_dim1], &ctemp, 
00819                                          &realc, &s, &dummy);
00820                                 clarnd_(&q__1, &c__5, &iseed[1]);
00821                                 dummy.r = q__1.r, dummy.i = q__1.i;
00822                                 q__2.r = realc * dummy.r, q__2.i = realc * 
00823                                         dummy.i;
00824                                 r_cnjg(&q__1, &q__2);
00825                                 c__.r = q__1.r, c__.i = q__1.i;
00826                                 q__3.r = -s.r, q__3.i = -s.i;
00827                                 q__2.r = q__3.r * dummy.r - q__3.i * dummy.i, 
00828                                         q__2.i = q__3.r * dummy.i + q__3.i * 
00829                                         dummy.r;
00830                                 r_cnjg(&q__1, &q__2);
00831                                 s.r = q__1.r, s.i = q__1.i;
00832 /* Computing MAX */
00833                                 i__4 = 1, i__5 = jch - jkl - jku;
00834                                 irow = max(i__4,i__5);
00835                                 il = ir + 2 - irow;
00836                                 extra.r = 0.f, extra.i = 0.f;
00837                                 L__1 = jch > jkl + jku;
00838                                 clarot_(&c_false, &L__1, &c_true, &il, &c__, &
00839                                         s, &a[irow - iskew * icol + ioffst + 
00840                                         icol * a_dim1], &ilda, &extra, &ctemp)
00841                                         ;
00842                                 ic = icol;
00843                                 ir = irow;
00844                             }
00845 /* L170: */
00846                         }
00847 /* L180: */
00848                     }
00849 /* L190: */
00850                 }
00851 
00852             } else {
00853 
00854 /*              Bottom-Up -- Start at the bottom right. */
00855 
00856                 jkl = 0;
00857                 i__1 = uub;
00858                 for (jku = 1; jku <= i__1; ++jku) {
00859 
00860 /*                 Transform from bandwidth JKL, JKU-1 to JKL, JKU */
00861 
00862 /*                 First row actually rotated is M */
00863 /*                 First column actually rotated is MIN( M+JKU, N ) */
00864 
00865 /* Computing MIN */
00866                     i__2 = *m, i__3 = *n + jkl;
00867                     iendch = min(i__2,i__3) - 1;
00868 /* Computing MIN */
00869                     i__2 = *m + jku;
00870                     i__3 = 1 - jkl;
00871                     for (jc = min(i__2,*n) - 1; jc >= i__3; --jc) {
00872                         extra.r = 0.f, extra.i = 0.f;
00873                         angle = slarnd_(&c__1, &iseed[1]) * 
00874                                 6.2831853071795864769252867663f;
00875                         r__1 = cos(angle);
00876                         clarnd_(&q__2, &c__5, &iseed[1]);
00877                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00878                         c__.r = q__1.r, c__.i = q__1.i;
00879                         r__1 = sin(angle);
00880                         clarnd_(&q__2, &c__5, &iseed[1]);
00881                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00882                         s.r = q__1.r, s.i = q__1.i;
00883 /* Computing MAX */
00884                         i__2 = 1, i__4 = jc - jku + 1;
00885                         irow = max(i__2,i__4);
00886                         if (jc > 0) {
00887 /* Computing MIN */
00888                             i__2 = *m, i__4 = jc + jkl + 1;
00889                             il = min(i__2,i__4) + 1 - irow;
00890                             L__1 = jc + jkl < *m;
00891                             clarot_(&c_false, &c_false, &L__1, &il, &c__, &s, 
00892                                     &a[irow - iskew * jc + ioffst + jc * 
00893                                     a_dim1], &ilda, &dummy, &extra);
00894                         }
00895 
00896 /*                    Chase "EXTRA" back down */
00897 
00898                         ic = jc;
00899                         i__2 = iendch;
00900                         i__4 = jkl + jku;
00901                         for (jch = jc + jkl; i__4 < 0 ? jch >= i__2 : jch <= 
00902                                 i__2; jch += i__4) {
00903                             ilextr = ic > 0;
00904                             if (ilextr) {
00905                                 clartg_(&a[jch - iskew * ic + ioffst + ic * 
00906                                         a_dim1], &extra, &realc, &s, &dummy);
00907                                 clarnd_(&q__1, &c__5, &iseed[1]);
00908                                 dummy.r = q__1.r, dummy.i = q__1.i;
00909                                 q__1.r = realc * dummy.r, q__1.i = realc * 
00910                                         dummy.i;
00911                                 c__.r = q__1.r, c__.i = q__1.i;
00912                                 q__1.r = s.r * dummy.r - s.i * dummy.i, 
00913                                         q__1.i = s.r * dummy.i + s.i * 
00914                                         dummy.r;
00915                                 s.r = q__1.r, s.i = q__1.i;
00916                             }
00917                             ic = max(1,ic);
00918 /* Computing MIN */
00919                             i__5 = *n - 1, i__6 = jch + jku;
00920                             icol = min(i__5,i__6);
00921                             iltemp = jch + jku < *n;
00922                             ctemp.r = 0.f, ctemp.i = 0.f;
00923                             i__5 = icol + 2 - ic;
00924                             clarot_(&c_true, &ilextr, &iltemp, &i__5, &c__, &
00925                                     s, &a[jch - iskew * ic + ioffst + ic * 
00926                                     a_dim1], &ilda, &extra, &ctemp);
00927                             if (iltemp) {
00928                                 clartg_(&a[jch - iskew * icol + ioffst + icol 
00929                                         * a_dim1], &ctemp, &realc, &s, &dummy)
00930                                         ;
00931                                 clarnd_(&q__1, &c__5, &iseed[1]);
00932                                 dummy.r = q__1.r, dummy.i = q__1.i;
00933                                 q__1.r = realc * dummy.r, q__1.i = realc * 
00934                                         dummy.i;
00935                                 c__.r = q__1.r, c__.i = q__1.i;
00936                                 q__1.r = s.r * dummy.r - s.i * dummy.i, 
00937                                         q__1.i = s.r * dummy.i + s.i * 
00938                                         dummy.r;
00939                                 s.r = q__1.r, s.i = q__1.i;
00940 /* Computing MIN */
00941                                 i__5 = iendch, i__6 = jch + jkl + jku;
00942                                 il = min(i__5,i__6) + 2 - jch;
00943                                 extra.r = 0.f, extra.i = 0.f;
00944                                 L__1 = jch + jkl + jku <= iendch;
00945                                 clarot_(&c_false, &c_true, &L__1, &il, &c__, &
00946                                         s, &a[jch - iskew * icol + ioffst + 
00947                                         icol * a_dim1], &ilda, &ctemp, &extra)
00948                                         ;
00949                                 ic = icol;
00950                             }
00951 /* L200: */
00952                         }
00953 /* L210: */
00954                     }
00955 /* L220: */
00956                 }
00957 
00958                 jku = uub;
00959                 i__1 = llb;
00960                 for (jkl = 1; jkl <= i__1; ++jkl) {
00961 
00962 /*                 Transform from bandwidth JKL-1, JKU to JKL, JKU */
00963 
00964 /*                 First row actually rotated is MIN( N+JKL, M ) */
00965 /*                 First column actually rotated is N */
00966 
00967 /* Computing MIN */
00968                     i__3 = *n, i__4 = *m + jku;
00969                     iendch = min(i__3,i__4) - 1;
00970 /* Computing MIN */
00971                     i__3 = *n + jkl;
00972                     i__4 = 1 - jku;
00973                     for (jr = min(i__3,*m) - 1; jr >= i__4; --jr) {
00974                         extra.r = 0.f, extra.i = 0.f;
00975                         angle = slarnd_(&c__1, &iseed[1]) * 
00976                                 6.2831853071795864769252867663f;
00977                         r__1 = cos(angle);
00978                         clarnd_(&q__2, &c__5, &iseed[1]);
00979                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00980                         c__.r = q__1.r, c__.i = q__1.i;
00981                         r__1 = sin(angle);
00982                         clarnd_(&q__2, &c__5, &iseed[1]);
00983                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
00984                         s.r = q__1.r, s.i = q__1.i;
00985 /* Computing MAX */
00986                         i__3 = 1, i__2 = jr - jkl + 1;
00987                         icol = max(i__3,i__2);
00988                         if (jr > 0) {
00989 /* Computing MIN */
00990                             i__3 = *n, i__2 = jr + jku + 1;
00991                             il = min(i__3,i__2) + 1 - icol;
00992                             L__1 = jr + jku < *n;
00993                             clarot_(&c_true, &c_false, &L__1, &il, &c__, &s, &
00994                                     a[jr - iskew * icol + ioffst + icol * 
00995                                     a_dim1], &ilda, &dummy, &extra);
00996                         }
00997 
00998 /*                    Chase "EXTRA" back down */
00999 
01000                         ir = jr;
01001                         i__3 = iendch;
01002                         i__2 = jkl + jku;
01003                         for (jch = jr + jku; i__2 < 0 ? jch >= i__3 : jch <= 
01004                                 i__3; jch += i__2) {
01005                             ilextr = ir > 0;
01006                             if (ilextr) {
01007                                 clartg_(&a[ir - iskew * jch + ioffst + jch * 
01008                                         a_dim1], &extra, &realc, &s, &dummy);
01009                                 clarnd_(&q__1, &c__5, &iseed[1]);
01010                                 dummy.r = q__1.r, dummy.i = q__1.i;
01011                                 q__1.r = realc * dummy.r, q__1.i = realc * 
01012                                         dummy.i;
01013                                 c__.r = q__1.r, c__.i = q__1.i;
01014                                 q__1.r = s.r * dummy.r - s.i * dummy.i, 
01015                                         q__1.i = s.r * dummy.i + s.i * 
01016                                         dummy.r;
01017                                 s.r = q__1.r, s.i = q__1.i;
01018                             }
01019                             ir = max(1,ir);
01020 /* Computing MIN */
01021                             i__5 = *m - 1, i__6 = jch + jkl;
01022                             irow = min(i__5,i__6);
01023                             iltemp = jch + jkl < *m;
01024                             ctemp.r = 0.f, ctemp.i = 0.f;
01025                             i__5 = irow + 2 - ir;
01026                             clarot_(&c_false, &ilextr, &iltemp, &i__5, &c__, &
01027                                     s, &a[ir - iskew * jch + ioffst + jch * 
01028                                     a_dim1], &ilda, &extra, &ctemp);
01029                             if (iltemp) {
01030                                 clartg_(&a[irow - iskew * jch + ioffst + jch *
01031                                          a_dim1], &ctemp, &realc, &s, &dummy);
01032                                 clarnd_(&q__1, &c__5, &iseed[1]);
01033                                 dummy.r = q__1.r, dummy.i = q__1.i;
01034                                 q__1.r = realc * dummy.r, q__1.i = realc * 
01035                                         dummy.i;
01036                                 c__.r = q__1.r, c__.i = q__1.i;
01037                                 q__1.r = s.r * dummy.r - s.i * dummy.i, 
01038                                         q__1.i = s.r * dummy.i + s.i * 
01039                                         dummy.r;
01040                                 s.r = q__1.r, s.i = q__1.i;
01041 /* Computing MIN */
01042                                 i__5 = iendch, i__6 = jch + jkl + jku;
01043                                 il = min(i__5,i__6) + 2 - jch;
01044                                 extra.r = 0.f, extra.i = 0.f;
01045                                 L__1 = jch + jkl + jku <= iendch;
01046                                 clarot_(&c_true, &c_true, &L__1, &il, &c__, &
01047                                         s, &a[irow - iskew * jch + ioffst + 
01048                                         jch * a_dim1], &ilda, &ctemp, &extra);
01049                                 ir = irow;
01050                             }
01051 /* L230: */
01052                         }
01053 /* L240: */
01054                     }
01055 /* L250: */
01056                 }
01057 
01058             }
01059 
01060         } else {
01061 
01062 /*           Symmetric -- A = U D U' */
01063 /*           Hermitian -- A = U D U* */
01064 
01065             ipackg = ipack;
01066             ioffg = ioffst;
01067 
01068             if (topdwn) {
01069 
01070 /*              Top-Down -- Generate Upper triangle only */
01071 
01072                 if (ipack >= 5) {
01073                     ipackg = 6;
01074                     ioffg = uub + 1;
01075                 } else {
01076                     ipackg = 1;
01077                 }
01078 
01079                 i__1 = mnmin;
01080                 for (j = 1; j <= i__1; ++j) {
01081                     i__4 = (1 - iskew) * j + ioffg + j * a_dim1;
01082                     i__2 = j;
01083                     q__1.r = d__[i__2], q__1.i = 0.f;
01084                     a[i__4].r = q__1.r, a[i__4].i = q__1.i;
01085 /* L260: */
01086                 }
01087 
01088                 i__1 = uub;
01089                 for (k = 1; k <= i__1; ++k) {
01090                     i__4 = *n - 1;
01091                     for (jc = 1; jc <= i__4; ++jc) {
01092 /* Computing MAX */
01093                         i__2 = 1, i__3 = jc - k;
01094                         irow = max(i__2,i__3);
01095 /* Computing MIN */
01096                         i__2 = jc + 1, i__3 = k + 2;
01097                         il = min(i__2,i__3);
01098                         extra.r = 0.f, extra.i = 0.f;
01099                         i__2 = jc - iskew * (jc + 1) + ioffg + (jc + 1) * 
01100                                 a_dim1;
01101                         ctemp.r = a[i__2].r, ctemp.i = a[i__2].i;
01102                         angle = slarnd_(&c__1, &iseed[1]) * 
01103                                 6.2831853071795864769252867663f;
01104                         r__1 = cos(angle);
01105                         clarnd_(&q__2, &c__5, &iseed[1]);
01106                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
01107                         c__.r = q__1.r, c__.i = q__1.i;
01108                         r__1 = sin(angle);
01109                         clarnd_(&q__2, &c__5, &iseed[1]);
01110                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
01111                         s.r = q__1.r, s.i = q__1.i;
01112                         if (csym) {
01113                             ct.r = c__.r, ct.i = c__.i;
01114                             st.r = s.r, st.i = s.i;
01115                         } else {
01116                             r_cnjg(&q__1, &ctemp);
01117                             ctemp.r = q__1.r, ctemp.i = q__1.i;
01118                             r_cnjg(&q__1, &c__);
01119                             ct.r = q__1.r, ct.i = q__1.i;
01120                             r_cnjg(&q__1, &s);
01121                             st.r = q__1.r, st.i = q__1.i;
01122                         }
01123                         L__1 = jc > k;
01124                         clarot_(&c_false, &L__1, &c_true, &il, &c__, &s, &a[
01125                                 irow - iskew * jc + ioffg + jc * a_dim1], &
01126                                 ilda, &extra, &ctemp);
01127 /* Computing MIN */
01128                         i__3 = k, i__5 = *n - jc;
01129                         i__2 = min(i__3,i__5) + 1;
01130                         clarot_(&c_true, &c_true, &c_false, &i__2, &ct, &st, &
01131                                 a[(1 - iskew) * jc + ioffg + jc * a_dim1], &
01132                                 ilda, &ctemp, &dummy);
01133 
01134 /*                    Chase EXTRA back up the matrix */
01135 
01136                         icol = jc;
01137                         i__2 = -k;
01138                         for (jch = jc - k; i__2 < 0 ? jch >= 1 : jch <= 1; 
01139                                 jch += i__2) {
01140                             clartg_(&a[jch + 1 - iskew * (icol + 1) + ioffg + 
01141                                     (icol + 1) * a_dim1], &extra, &realc, &s, 
01142                                     &dummy);
01143                             clarnd_(&q__1, &c__5, &iseed[1]);
01144                             dummy.r = q__1.r, dummy.i = q__1.i;
01145                             q__2.r = realc * dummy.r, q__2.i = realc * 
01146                                     dummy.i;
01147                             r_cnjg(&q__1, &q__2);
01148                             c__.r = q__1.r, c__.i = q__1.i;
01149                             q__3.r = -s.r, q__3.i = -s.i;
01150                             q__2.r = q__3.r * dummy.r - q__3.i * dummy.i, 
01151                                     q__2.i = q__3.r * dummy.i + q__3.i * 
01152                                     dummy.r;
01153                             r_cnjg(&q__1, &q__2);
01154                             s.r = q__1.r, s.i = q__1.i;
01155                             i__3 = jch - iskew * (jch + 1) + ioffg + (jch + 1)
01156                                      * a_dim1;
01157                             ctemp.r = a[i__3].r, ctemp.i = a[i__3].i;
01158                             if (csym) {
01159                                 ct.r = c__.r, ct.i = c__.i;
01160                                 st.r = s.r, st.i = s.i;
01161                             } else {
01162                                 r_cnjg(&q__1, &ctemp);
01163                                 ctemp.r = q__1.r, ctemp.i = q__1.i;
01164                                 r_cnjg(&q__1, &c__);
01165                                 ct.r = q__1.r, ct.i = q__1.i;
01166                                 r_cnjg(&q__1, &s);
01167                                 st.r = q__1.r, st.i = q__1.i;
01168                             }
01169                             i__3 = k + 2;
01170                             clarot_(&c_true, &c_true, &c_true, &i__3, &c__, &
01171                                     s, &a[(1 - iskew) * jch + ioffg + jch * 
01172                                     a_dim1], &ilda, &ctemp, &extra);
01173 /* Computing MAX */
01174                             i__3 = 1, i__5 = jch - k;
01175                             irow = max(i__3,i__5);
01176 /* Computing MIN */
01177                             i__3 = jch + 1, i__5 = k + 2;
01178                             il = min(i__3,i__5);
01179                             extra.r = 0.f, extra.i = 0.f;
01180                             L__1 = jch > k;
01181                             clarot_(&c_false, &L__1, &c_true, &il, &ct, &st, &
01182                                     a[irow - iskew * jch + ioffg + jch * 
01183                                     a_dim1], &ilda, &extra, &ctemp);
01184                             icol = jch;
01185 /* L270: */
01186                         }
01187 /* L280: */
01188                     }
01189 /* L290: */
01190                 }
01191 
01192 /*              If we need lower triangle, copy from upper. Note that */
01193 /*              the order of copying is chosen to work for 'q' -> 'b' */
01194 
01195                 if (ipack != ipackg && ipack != 3) {
01196                     i__1 = *n;
01197                     for (jc = 1; jc <= i__1; ++jc) {
01198                         irow = ioffst - iskew * jc;
01199                         if (csym) {
01200 /* Computing MIN */
01201                             i__2 = *n, i__3 = jc + uub;
01202                             i__4 = min(i__2,i__3);
01203                             for (jr = jc; jr <= i__4; ++jr) {
01204                                 i__2 = jr + irow + jc * a_dim1;
01205                                 i__3 = jc - iskew * jr + ioffg + jr * a_dim1;
01206                                 a[i__2].r = a[i__3].r, a[i__2].i = a[i__3].i;
01207 /* L300: */
01208                             }
01209                         } else {
01210 /* Computing MIN */
01211                             i__2 = *n, i__3 = jc + uub;
01212                             i__4 = min(i__2,i__3);
01213                             for (jr = jc; jr <= i__4; ++jr) {
01214                                 i__2 = jr + irow + jc * a_dim1;
01215                                 r_cnjg(&q__1, &a[jc - iskew * jr + ioffg + jr 
01216                                         * a_dim1]);
01217                                 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
01218 /* L310: */
01219                             }
01220                         }
01221 /* L320: */
01222                     }
01223                     if (ipack == 5) {
01224                         i__1 = *n;
01225                         for (jc = *n - uub + 1; jc <= i__1; ++jc) {
01226                             i__4 = uub + 1;
01227                             for (jr = *n + 2 - jc; jr <= i__4; ++jr) {
01228                                 i__2 = jr + jc * a_dim1;
01229                                 a[i__2].r = 0.f, a[i__2].i = 0.f;
01230 /* L330: */
01231                             }
01232 /* L340: */
01233                         }
01234                     }
01235                     if (ipackg == 6) {
01236                         ipackg = ipack;
01237                     } else {
01238                         ipackg = 0;
01239                     }
01240                 }
01241             } else {
01242 
01243 /*              Bottom-Up -- Generate Lower triangle only */
01244 
01245                 if (ipack >= 5) {
01246                     ipackg = 5;
01247                     if (ipack == 6) {
01248                         ioffg = 1;
01249                     }
01250                 } else {
01251                     ipackg = 2;
01252                 }
01253 
01254                 i__1 = mnmin;
01255                 for (j = 1; j <= i__1; ++j) {
01256                     i__4 = (1 - iskew) * j + ioffg + j * a_dim1;
01257                     i__2 = j;
01258                     q__1.r = d__[i__2], q__1.i = 0.f;
01259                     a[i__4].r = q__1.r, a[i__4].i = q__1.i;
01260 /* L350: */
01261                 }
01262 
01263                 i__1 = uub;
01264                 for (k = 1; k <= i__1; ++k) {
01265                     for (jc = *n - 1; jc >= 1; --jc) {
01266 /* Computing MIN */
01267                         i__4 = *n + 1 - jc, i__2 = k + 2;
01268                         il = min(i__4,i__2);
01269                         extra.r = 0.f, extra.i = 0.f;
01270                         i__4 = (1 - iskew) * jc + 1 + ioffg + jc * a_dim1;
01271                         ctemp.r = a[i__4].r, ctemp.i = a[i__4].i;
01272                         angle = slarnd_(&c__1, &iseed[1]) * 
01273                                 6.2831853071795864769252867663f;
01274                         r__1 = cos(angle);
01275                         clarnd_(&q__2, &c__5, &iseed[1]);
01276                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
01277                         c__.r = q__1.r, c__.i = q__1.i;
01278                         r__1 = sin(angle);
01279                         clarnd_(&q__2, &c__5, &iseed[1]);
01280                         q__1.r = r__1 * q__2.r, q__1.i = r__1 * q__2.i;
01281                         s.r = q__1.r, s.i = q__1.i;
01282                         if (csym) {
01283                             ct.r = c__.r, ct.i = c__.i;
01284                             st.r = s.r, st.i = s.i;
01285                         } else {
01286                             r_cnjg(&q__1, &ctemp);
01287                             ctemp.r = q__1.r, ctemp.i = q__1.i;
01288                             r_cnjg(&q__1, &c__);
01289                             ct.r = q__1.r, ct.i = q__1.i;
01290                             r_cnjg(&q__1, &s);
01291                             st.r = q__1.r, st.i = q__1.i;
01292                         }
01293                         L__1 = *n - jc > k;
01294                         clarot_(&c_false, &c_true, &L__1, &il, &c__, &s, &a[(
01295                                 1 - iskew) * jc + ioffg + jc * a_dim1], &ilda, 
01296                                  &ctemp, &extra);
01297 /* Computing MAX */
01298                         i__4 = 1, i__2 = jc - k + 1;
01299                         icol = max(i__4,i__2);
01300                         i__4 = jc + 2 - icol;
01301                         clarot_(&c_true, &c_false, &c_true, &i__4, &ct, &st, &
01302                                 a[jc - iskew * icol + ioffg + icol * a_dim1], 
01303                                 &ilda, &dummy, &ctemp);
01304 
01305 /*                    Chase EXTRA back down the matrix */
01306 
01307                         icol = jc;
01308                         i__4 = *n - 1;
01309                         i__2 = k;
01310                         for (jch = jc + k; i__2 < 0 ? jch >= i__4 : jch <= 
01311                                 i__4; jch += i__2) {
01312                             clartg_(&a[jch - iskew * icol + ioffg + icol * 
01313                                     a_dim1], &extra, &realc, &s, &dummy);
01314                             clarnd_(&q__1, &c__5, &iseed[1]);
01315                             dummy.r = q__1.r, dummy.i = q__1.i;
01316                             q__1.r = realc * dummy.r, q__1.i = realc * 
01317                                     dummy.i;
01318                             c__.r = q__1.r, c__.i = q__1.i;
01319                             q__1.r = s.r * dummy.r - s.i * dummy.i, q__1.i = 
01320                                     s.r * dummy.i + s.i * dummy.r;
01321                             s.r = q__1.r, s.i = q__1.i;
01322                             i__3 = (1 - iskew) * jch + 1 + ioffg + jch * 
01323                                     a_dim1;
01324                             ctemp.r = a[i__3].r, ctemp.i = a[i__3].i;
01325                             if (csym) {
01326                                 ct.r = c__.r, ct.i = c__.i;
01327                                 st.r = s.r, st.i = s.i;
01328                             } else {
01329                                 r_cnjg(&q__1, &ctemp);
01330                                 ctemp.r = q__1.r, ctemp.i = q__1.i;
01331                                 r_cnjg(&q__1, &c__);
01332                                 ct.r = q__1.r, ct.i = q__1.i;
01333                                 r_cnjg(&q__1, &s);
01334                                 st.r = q__1.r, st.i = q__1.i;
01335                             }
01336                             i__3 = k + 2;
01337                             clarot_(&c_true, &c_true, &c_true, &i__3, &c__, &
01338                                     s, &a[jch - iskew * icol + ioffg + icol * 
01339                                     a_dim1], &ilda, &extra, &ctemp);
01340 /* Computing MIN */
01341                             i__3 = *n + 1 - jch, i__5 = k + 2;
01342                             il = min(i__3,i__5);
01343                             extra.r = 0.f, extra.i = 0.f;
01344                             L__1 = *n - jch > k;
01345                             clarot_(&c_false, &c_true, &L__1, &il, &ct, &st, &
01346                                     a[(1 - iskew) * jch + ioffg + jch * 
01347                                     a_dim1], &ilda, &ctemp, &extra);
01348                             icol = jch;
01349 /* L360: */
01350                         }
01351 /* L370: */
01352                     }
01353 /* L380: */
01354                 }
01355 
01356 /*              If we need upper triangle, copy from lower. Note that */
01357 /*              the order of copying is chosen to work for 'b' -> 'q' */
01358 
01359                 if (ipack != ipackg && ipack != 4) {
01360                     for (jc = *n; jc >= 1; --jc) {
01361                         irow = ioffst - iskew * jc;
01362                         if (csym) {
01363 /* Computing MAX */
01364                             i__2 = 1, i__4 = jc - uub;
01365                             i__1 = max(i__2,i__4);
01366                             for (jr = jc; jr >= i__1; --jr) {
01367                                 i__2 = jr + irow + jc * a_dim1;
01368                                 i__4 = jc - iskew * jr + ioffg + jr * a_dim1;
01369                                 a[i__2].r = a[i__4].r, a[i__2].i = a[i__4].i;
01370 /* L390: */
01371                             }
01372                         } else {
01373 /* Computing MAX */
01374                             i__2 = 1, i__4 = jc - uub;
01375                             i__1 = max(i__2,i__4);
01376                             for (jr = jc; jr >= i__1; --jr) {
01377                                 i__2 = jr + irow + jc * a_dim1;
01378                                 r_cnjg(&q__1, &a[jc - iskew * jr + ioffg + jr 
01379                                         * a_dim1]);
01380                                 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
01381 /* L400: */
01382                             }
01383                         }
01384 /* L410: */
01385                     }
01386                     if (ipack == 6) {
01387                         i__1 = uub;
01388                         for (jc = 1; jc <= i__1; ++jc) {
01389                             i__2 = uub + 1 - jc;
01390                             for (jr = 1; jr <= i__2; ++jr) {
01391                                 i__4 = jr + jc * a_dim1;
01392                                 a[i__4].r = 0.f, a[i__4].i = 0.f;
01393 /* L420: */
01394                             }
01395 /* L430: */
01396                         }
01397                     }
01398                     if (ipackg == 5) {
01399                         ipackg = ipack;
01400                     } else {
01401                         ipackg = 0;
01402                     }
01403                 }
01404             }
01405 
01406 /*           Ensure that the diagonal is real if Hermitian */
01407 
01408             if (! csym) {
01409                 i__1 = *n;
01410                 for (jc = 1; jc <= i__1; ++jc) {
01411                     irow = ioffst + (1 - iskew) * jc;
01412                     i__2 = irow + jc * a_dim1;
01413                     i__4 = irow + jc * a_dim1;
01414                     r__1 = a[i__4].r;
01415                     q__1.r = r__1, q__1.i = 0.f;
01416                     a[i__2].r = q__1.r, a[i__2].i = q__1.i;
01417 /* L440: */
01418                 }
01419             }
01420 
01421         }
01422 
01423     } else {
01424 
01425 /*        4)      Generate Banded Matrix by first */
01426 /*                Rotating by random Unitary matrices, */
01427 /*                then reducing the bandwidth using Householder */
01428 /*                transformations. */
01429 
01430 /*                Note: we should get here only if LDA .ge. N */
01431 
01432         if (isym == 1) {
01433 
01434 /*           Non-symmetric -- A = U D V */
01435 
01436             clagge_(&mr, &nc, &llb, &uub, &d__[1], &a[a_offset], lda, &iseed[
01437                     1], &work[1], &iinfo);
01438         } else {
01439 
01440 /*           Symmetric -- A = U D U' or */
01441 /*           Hermitian -- A = U D U* */
01442 
01443             if (csym) {
01444                 clagsy_(m, &llb, &d__[1], &a[a_offset], lda, &iseed[1], &work[
01445                         1], &iinfo);
01446             } else {
01447                 claghe_(m, &llb, &d__[1], &a[a_offset], lda, &iseed[1], &work[
01448                         1], &iinfo);
01449             }
01450         }
01451 
01452         if (iinfo != 0) {
01453             *info = 3;
01454             return 0;
01455         }
01456     }
01457 
01458 /*     5)      Pack the matrix */
01459 
01460     if (ipack != ipackg) {
01461         if (ipack == 1) {
01462 
01463 /*           'U' -- Upper triangular, not packed */
01464 
01465             i__1 = *m;
01466             for (j = 1; j <= i__1; ++j) {
01467                 i__2 = *m;
01468                 for (i__ = j + 1; i__ <= i__2; ++i__) {
01469                     i__4 = i__ + j * a_dim1;
01470                     a[i__4].r = 0.f, a[i__4].i = 0.f;
01471 /* L450: */
01472                 }
01473 /* L460: */
01474             }
01475 
01476         } else if (ipack == 2) {
01477 
01478 /*           'L' -- Lower triangular, not packed */
01479 
01480             i__1 = *m;
01481             for (j = 2; j <= i__1; ++j) {
01482                 i__2 = j - 1;
01483                 for (i__ = 1; i__ <= i__2; ++i__) {
01484                     i__4 = i__ + j * a_dim1;
01485                     a[i__4].r = 0.f, a[i__4].i = 0.f;
01486 /* L470: */
01487                 }
01488 /* L480: */
01489             }
01490 
01491         } else if (ipack == 3) {
01492 
01493 /*           'C' -- Upper triangle packed Columnwise. */
01494 
01495             icol = 1;
01496             irow = 0;
01497             i__1 = *m;
01498             for (j = 1; j <= i__1; ++j) {
01499                 i__2 = j;
01500                 for (i__ = 1; i__ <= i__2; ++i__) {
01501                     ++irow;
01502                     if (irow > *lda) {
01503                         irow = 1;
01504                         ++icol;
01505                     }
01506                     i__4 = irow + icol * a_dim1;
01507                     i__3 = i__ + j * a_dim1;
01508                     a[i__4].r = a[i__3].r, a[i__4].i = a[i__3].i;
01509 /* L490: */
01510                 }
01511 /* L500: */
01512             }
01513 
01514         } else if (ipack == 4) {
01515 
01516 /*           'R' -- Lower triangle packed Columnwise. */
01517 
01518             icol = 1;
01519             irow = 0;
01520             i__1 = *m;
01521             for (j = 1; j <= i__1; ++j) {
01522                 i__2 = *m;
01523                 for (i__ = j; i__ <= i__2; ++i__) {
01524                     ++irow;
01525                     if (irow > *lda) {
01526                         irow = 1;
01527                         ++icol;
01528                     }
01529                     i__4 = irow + icol * a_dim1;
01530                     i__3 = i__ + j * a_dim1;
01531                     a[i__4].r = a[i__3].r, a[i__4].i = a[i__3].i;
01532 /* L510: */
01533                 }
01534 /* L520: */
01535             }
01536 
01537         } else if (ipack >= 5) {
01538 
01539 /*           'B' -- The lower triangle is packed as a band matrix. */
01540 /*           'Q' -- The upper triangle is packed as a band matrix. */
01541 /*           'Z' -- The whole matrix is packed as a band matrix. */
01542 
01543             if (ipack == 5) {
01544                 uub = 0;
01545             }
01546             if (ipack == 6) {
01547                 llb = 0;
01548             }
01549 
01550             i__1 = uub;
01551             for (j = 1; j <= i__1; ++j) {
01552 /* Computing MIN */
01553                 i__2 = j + llb;
01554                 for (i__ = min(i__2,*m); i__ >= 1; --i__) {
01555                     i__2 = i__ - j + uub + 1 + j * a_dim1;
01556                     i__4 = i__ + j * a_dim1;
01557                     a[i__2].r = a[i__4].r, a[i__2].i = a[i__4].i;
01558 /* L530: */
01559                 }
01560 /* L540: */
01561             }
01562 
01563             i__1 = *n;
01564             for (j = uub + 2; j <= i__1; ++j) {
01565 /* Computing MIN */
01566                 i__4 = j + llb;
01567                 i__2 = min(i__4,*m);
01568                 for (i__ = j - uub; i__ <= i__2; ++i__) {
01569                     i__4 = i__ - j + uub + 1 + j * a_dim1;
01570                     i__3 = i__ + j * a_dim1;
01571                     a[i__4].r = a[i__3].r, a[i__4].i = a[i__3].i;
01572 /* L550: */
01573                 }
01574 /* L560: */
01575             }
01576         }
01577 
01578 /*        If packed, zero out extraneous elements. */
01579 
01580 /*        Symmetric/Triangular Packed -- */
01581 /*        zero out everything after A(IROW,ICOL) */
01582 
01583         if (ipack == 3 || ipack == 4) {
01584             i__1 = *m;
01585             for (jc = icol; jc <= i__1; ++jc) {
01586                 i__2 = *lda;
01587                 for (jr = irow + 1; jr <= i__2; ++jr) {
01588                     i__4 = jr + jc * a_dim1;
01589                     a[i__4].r = 0.f, a[i__4].i = 0.f;
01590 /* L570: */
01591                 }
01592                 irow = 0;
01593 /* L580: */
01594             }
01595 
01596         } else if (ipack >= 5) {
01597 
01598 /*           Packed Band -- */
01599 /*              1st row is now in A( UUB+2-j, j), zero above it */
01600 /*              m-th row is now in A( M+UUB-j,j), zero below it */
01601 /*              last non-zero diagonal is now in A( UUB+LLB+1,j ), */
01602 /*                 zero below it, too. */
01603 
01604             ir1 = uub + llb + 2;
01605             ir2 = uub + *m + 2;
01606             i__1 = *n;
01607             for (jc = 1; jc <= i__1; ++jc) {
01608                 i__2 = uub + 1 - jc;
01609                 for (jr = 1; jr <= i__2; ++jr) {
01610                     i__4 = jr + jc * a_dim1;
01611                     a[i__4].r = 0.f, a[i__4].i = 0.f;
01612 /* L590: */
01613                 }
01614 /* Computing MAX */
01615 /* Computing MIN */
01616                 i__3 = ir1, i__5 = ir2 - jc;
01617                 i__2 = 1, i__4 = min(i__3,i__5);
01618                 i__6 = *lda;
01619                 for (jr = max(i__2,i__4); jr <= i__6; ++jr) {
01620                     i__2 = jr + jc * a_dim1;
01621                     a[i__2].r = 0.f, a[i__2].i = 0.f;
01622 /* L600: */
01623                 }
01624 /* L610: */
01625             }
01626         }
01627     }
01628 
01629     return 0;
01630 
01631 /*     End of CLATMT */
01632 
01633 } /* clatmt_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:32