kusano 7d535a
/*  -- translated by f2c (version 19940927).
kusano 7d535a
   You must link the resulting object file with the libraries:
kusano 7d535a
	-lf2c -lm   (in that order)
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
#include "f2c.h"
kusano 7d535a
kusano 7d535a
/* Table of constant values */
kusano 7d535a
kusano 7d535a
static integer c__1 = 1;
kusano 7d535a
static real c_b22 = 0.f;
kusano 7d535a
static logical c_true = TRUE_;
kusano 7d535a
static logical c_false = FALSE_;
kusano 7d535a
kusano 7d535a
/* Subroutine */ int slatms_(integer *m, integer *n, char *dist, integer *
kusano 7d535a
	iseed, char *sym, real *d, integer *mode, real *cond, real *dmax__, 
kusano 7d535a
	integer *kl, integer *ku, char *pack, real *a, integer *lda, real *
kusano 7d535a
	work, integer *info)
kusano 7d535a
{
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
kusano 7d535a
    real r__1, r__2, r__3;
kusano 7d535a
    logical L__1;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    double cos(doublereal), sin(doublereal);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static integer ilda, icol;
kusano 7d535a
    static real temp;
kusano 7d535a
    static integer irow, isym;
kusano 7d535a
    static real c;
kusano 7d535a
    static integer i, j, k;
kusano 7d535a
    static real s, alpha, angle;
kusano 7d535a
    static integer ipack, ioffg;
kusano 7d535a
    extern logical lsame_(char *, char *);
kusano 7d535a
    static integer iinfo;
kusano 7d535a
    extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
kusano 7d535a
    static integer idist, mnmin, iskew;
kusano 7d535a
    static real extra, dummy;
kusano 7d535a
    extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *, 
kusano 7d535a
	    integer *), slatm1_(integer *, real *, integer *, integer *, 
kusano 7d535a
	    integer *, real *, integer *, integer *);
kusano 7d535a
    static integer ic, jc, nc, il, iendch, ir, jr, ipackg, mr;
kusano 7d535a
    extern /* Subroutine */ int slagge_(integer *, integer *, integer *, 
kusano 7d535a
	    integer *, real *, real *, integer *, integer *, real *, integer *
kusano 7d535a
	    );
kusano 7d535a
    static integer minlda;
kusano 7d535a
    extern /* Subroutine */ int xerbla_(char *, integer *);
kusano 7d535a
    extern doublereal slarnd_(integer *, integer *);
kusano 7d535a
    static logical iltemp, givens;
kusano 7d535a
    static integer ioffst, irsign;
kusano 7d535a
    extern /* Subroutine */ int slartg_(real *, real *, real *, real *, real *
kusano 7d535a
	    ), slaset_(char *, integer *, integer *, real *, real *, real *, 
kusano 7d535a
	    integer *), slagsy_(integer *, integer *, real *, real *, 
kusano 7d535a
	    integer *, integer *, real *, integer *), slarot_(logical *, 
kusano 7d535a
	    logical *, logical *, integer *, real *, real *, real *, integer *
kusano 7d535a
	    , real *, real *);
kusano 7d535a
    static logical ilextr, topdwn;
kusano 7d535a
    static integer ir1, ir2, isympk, jch, llb, jkl, jku, uub;
kusano 7d535a
kusano 7d535a
kusano 7d535a
/*  -- LAPACK test routine (version 2.0) --   
kusano 7d535a
       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
kusano 7d535a
       Courant Institute, Argonne National Lab, and Rice University   
kusano 7d535a
       September 30, 1994   
kusano 7d535a
kusano 7d535a
kusano 7d535a
    Purpose   
kusano 7d535a
    =======   
kusano 7d535a
kusano 7d535a
       SLATMS generates random matrices with specified singular values   
kusano 7d535a
       (or symmetric/hermitian with specified eigenvalues)   
kusano 7d535a
       for testing LAPACK programs.   
kusano 7d535a
kusano 7d535a
       SLATMS operates by applying the following sequence of   
kusano 7d535a
       operations:   
kusano 7d535a
kusano 7d535a
         Set the diagonal to D, where D may be input or   
kusano 7d535a
            computed according to MODE, COND, DMAX, and SYM   
kusano 7d535a
            as described below.   
kusano 7d535a
kusano 7d535a
         Generate a matrix with the appropriate band structure, by one   
kusano 7d535a
            of two methods:   
kusano 7d535a
kusano 7d535a
         Method A:   
kusano 7d535a
             Generate a dense M x N matrix by multiplying D on the left   
kusano 7d535a
                 and the right by random unitary matrices, then:   
kusano 7d535a
kusano 7d535a
             Reduce the bandwidth according to KL and KU, using   
kusano 7d535a
             Householder transformations.   
kusano 7d535a
kusano 7d535a
         Method B:   
kusano 7d535a
             Convert the bandwidth-0 (i.e., diagonal) matrix to a   
kusano 7d535a
                 bandwidth-1 matrix using Givens rotations, "chasing"   
kusano 7d535a
                 out-of-band elements back, much as in QR; then   
kusano 7d535a
                 convert the bandwidth-1 to a bandwidth-2 matrix, etc.   
kusano 7d535a
                 Note that for reasonably small bandwidths (relative to   
kusano 7d535a
                 M and N) this requires less storage, as a dense matrix   
kusano 7d535a
                 is not generated.  Also, for symmetric matrices, only   
kusano 7d535a
                 one triangle is generated.   
kusano 7d535a
kusano 7d535a
         Method A is chosen if the bandwidth is a large fraction of the   
kusano 7d535a
             order of the matrix, and LDA is at least M (so a dense   
kusano 7d535a
             matrix can be stored.)  Method B is chosen if the bandwidth 
kusano 7d535a
  
kusano 7d535a
             is small (< 1/2 N for symmetric, < .3 N+M for   
kusano 7d535a
             non-symmetric), or LDA is less than M and not less than the 
kusano 7d535a
  
kusano 7d535a
             bandwidth.   
kusano 7d535a
kusano 7d535a
         Pack the matrix if desired. Options specified by PACK are:   
kusano 7d535a
            no packing   
kusano 7d535a
            zero out upper half (if symmetric)   
kusano 7d535a
            zero out lower half (if symmetric)   
kusano 7d535a
            store the upper half columnwise (if symmetric or upper   
kusano 7d535a
                  triangular)   
kusano 7d535a
            store the lower half columnwise (if symmetric or lower   
kusano 7d535a
                  triangular)   
kusano 7d535a
            store the lower triangle in banded format (if symmetric   
kusano 7d535a
                  or lower triangular)   
kusano 7d535a
            store the upper triangle in banded format (if symmetric   
kusano 7d535a
                  or upper triangular)   
kusano 7d535a
            store the entire matrix in banded format   
kusano 7d535a
         If Method B is chosen, and band format is specified, then the   
kusano 7d535a
            matrix will be generated in the band format, so no repacking 
kusano 7d535a
  
kusano 7d535a
            will be necessary.   
kusano 7d535a
kusano 7d535a
    Arguments   
kusano 7d535a
    =========   
kusano 7d535a
kusano 7d535a
    M      - INTEGER   
kusano 7d535a
             The number of rows of A. Not modified.   
kusano 7d535a
kusano 7d535a
    N      - INTEGER   
kusano 7d535a
             The number of columns of A. Not modified.   
kusano 7d535a
kusano 7d535a
    DIST   - CHARACTER*1   
kusano 7d535a
             On entry, DIST specifies the type of distribution to be used 
kusano 7d535a
  
kusano 7d535a
             to generate the random eigen-/singular values.   
kusano 7d535a
             'U' => UNIFORM( 0, 1 )  ( 'U' for uniform )   
kusano 7d535a
             'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )   
kusano 7d535a
             'N' => NORMAL( 0, 1 )   ( 'N' for normal )   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    ISEED  - INTEGER array, dimension ( 4 )   
kusano 7d535a
             On entry ISEED specifies the seed of the random number   
kusano 7d535a
             generator. They should lie between 0 and 4095 inclusive,   
kusano 7d535a
             and ISEED(4) should be odd. The random number generator   
kusano 7d535a
             uses a linear congruential sequence limited to small   
kusano 7d535a
             integers, and so should produce machine independent   
kusano 7d535a
             random numbers. The values of ISEED are changed on   
kusano 7d535a
             exit, and can be used in the next call to SLATMS   
kusano 7d535a
             to continue the same random number sequence.   
kusano 7d535a
             Changed on exit.   
kusano 7d535a
kusano 7d535a
    SYM    - CHARACTER*1   
kusano 7d535a
             If SYM='S' or 'H', the generated matrix is symmetric, with   
kusano 7d535a
               eigenvalues specified by D, COND, MODE, and DMAX; they   
kusano 7d535a
               may be positive, negative, or zero.   
kusano 7d535a
             If SYM='P', the generated matrix is symmetric, with   
kusano 7d535a
               eigenvalues (= singular values) specified by D, COND,   
kusano 7d535a
               MODE, and DMAX; they will not be negative.   
kusano 7d535a
             If SYM='N', the generated matrix is nonsymmetric, with   
kusano 7d535a
               singular values specified by D, COND, MODE, and DMAX;   
kusano 7d535a
               they will not be negative.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    D      - REAL array, dimension ( MIN( M , N ) )   
kusano 7d535a
             This array is used to specify the singular values or   
kusano 7d535a
             eigenvalues of A (see SYM, above.)  If MODE=0, then D is   
kusano 7d535a
             assumed to contain the singular/eigenvalues, otherwise   
kusano 7d535a
             they will be computed according to MODE, COND, and DMAX,   
kusano 7d535a
             and placed in D.   
kusano 7d535a
             Modified if MODE is nonzero.   
kusano 7d535a
kusano 7d535a
    MODE   - INTEGER   
kusano 7d535a
             On entry this describes how the singular/eigenvalues are to 
kusano 7d535a
  
kusano 7d535a
             be specified:   
kusano 7d535a
             MODE = 0 means use D as input   
kusano 7d535a
             MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND   
kusano 7d535a
             MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND   
kusano 7d535a
             MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))   
kusano 7d535a
             MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)   
kusano 7d535a
             MODE = 5 sets D to random numbers in the range   
kusano 7d535a
                      ( 1/COND , 1 ) such that their logarithms   
kusano 7d535a
                      are uniformly distributed.   
kusano 7d535a
             MODE = 6 set D to random numbers from same distribution   
kusano 7d535a
                      as the rest of the matrix.   
kusano 7d535a
             MODE < 0 has the same meaning as ABS(MODE), except that   
kusano 7d535a
                the order of the elements of D is reversed.   
kusano 7d535a
             Thus if MODE is positive, D has entries ranging from   
kusano 7d535a
                1 to 1/COND, if negative, from 1/COND to 1,   
kusano 7d535a
             If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then   
kusano 7d535a
                the elements of D will also be multiplied by a random   
kusano 7d535a
                sign (i.e., +1 or -1.)   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    COND   - REAL   
kusano 7d535a
             On entry, this is used as described under MODE above.   
kusano 7d535a
             If used, it must be >= 1. Not modified.   
kusano 7d535a
kusano 7d535a
    DMAX   - REAL   
kusano 7d535a
             If MODE is neither -6, 0 nor 6, the contents of D, as   
kusano 7d535a
             computed according to MODE and COND, will be scaled by   
kusano 7d535a
             DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or 
kusano 7d535a
  
kusano 7d535a
             singular value (which is to say the norm) will be abs(DMAX). 
kusano 7d535a
  
kusano 7d535a
             Note that DMAX need not be positive: if DMAX is negative   
kusano 7d535a
             (or zero), D will be scaled by a negative number (or zero). 
kusano 7d535a
  
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    KL     - INTEGER   
kusano 7d535a
             This specifies the lower bandwidth of the  matrix. For   
kusano 7d535a
             example, KL=0 implies upper triangular, KL=1 implies upper   
kusano 7d535a
             Hessenberg, and KL being at least M-1 means that the matrix 
kusano 7d535a
  
kusano 7d535a
             has full lower bandwidth.  KL must equal KU if the matrix   
kusano 7d535a
             is symmetric.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    KU     - INTEGER   
kusano 7d535a
             This specifies the upper bandwidth of the  matrix. For   
kusano 7d535a
             example, KU=0 implies lower triangular, KU=1 implies lower   
kusano 7d535a
             Hessenberg, and KU being at least N-1 means that the matrix 
kusano 7d535a
  
kusano 7d535a
             has full upper bandwidth.  KL must equal KU if the matrix   
kusano 7d535a
             is symmetric.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    PACK   - CHARACTER*1   
kusano 7d535a
             This specifies packing of matrix as follows:   
kusano 7d535a
             'N' => no packing   
kusano 7d535a
             'U' => zero out all subdiagonal entries (if symmetric)   
kusano 7d535a
             'L' => zero out all superdiagonal entries (if symmetric)   
kusano 7d535a
             'C' => store the upper triangle columnwise   
kusano 7d535a
                    (only if the matrix is symmetric or upper triangular) 
kusano 7d535a
  
kusano 7d535a
             'R' => store the lower triangle columnwise   
kusano 7d535a
                    (only if the matrix is symmetric or lower triangular) 
kusano 7d535a
  
kusano 7d535a
             'B' => store the lower triangle in band storage scheme   
kusano 7d535a
                    (only if matrix symmetric or lower triangular)   
kusano 7d535a
             'Q' => store the upper triangle in band storage scheme   
kusano 7d535a
                    (only if matrix symmetric or upper triangular)   
kusano 7d535a
             'Z' => store the entire matrix in band storage scheme   
kusano 7d535a
                        (pivoting can be provided for by using this   
kusano 7d535a
                        option to store A in the trailing rows of   
kusano 7d535a
                        the allocated storage)   
kusano 7d535a
kusano 7d535a
             Using these options, the various LAPACK packed and banded   
kusano 7d535a
             storage schemes can be obtained:   
kusano 7d535a
             GB               - use 'Z'   
kusano 7d535a
             PB, SB or TB     - use 'B' or 'Q'   
kusano 7d535a
             PP, SP or TP     - use 'C' or 'R'   
kusano 7d535a
kusano 7d535a
             If two calls to SLATMS differ only in the PACK parameter,   
kusano 7d535a
             they will generate mathematically equivalent matrices.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    A      - REAL array, dimension ( LDA, N )   
kusano 7d535a
             On exit A is the desired test matrix.  A is first generated 
kusano 7d535a
  
kusano 7d535a
             in full (unpacked) form, and then packed, if so specified   
kusano 7d535a
             by PACK.  Thus, the first M elements of the first N   
kusano 7d535a
             columns will always be modified.  If PACK specifies a   
kusano 7d535a
             packed or banded storage scheme, all LDA elements of the   
kusano 7d535a
             first N columns will be modified; the elements of the   
kusano 7d535a
             array which do not correspond to elements of the generated   
kusano 7d535a
             matrix are set to zero.   
kusano 7d535a
             Modified.   
kusano 7d535a
kusano 7d535a
    LDA    - INTEGER   
kusano 7d535a
             LDA specifies the first dimension of A as declared in the   
kusano 7d535a
             calling program.  If PACK='N', 'U', 'L', 'C', or 'R', then   
kusano 7d535a
             LDA must be at least M.  If PACK='B' or 'Q', then LDA must   
kusano 7d535a
             be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)).   
kusano 7d535a
             If PACK='Z', LDA must be large enough to hold the packed   
kusano 7d535a
             array: MIN( KU, N-1) + MIN( KL, M-1) + 1.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    WORK   - REAL array, dimension ( 3*MAX( N , M ) )   
kusano 7d535a
             Workspace.   
kusano 7d535a
             Modified.   
kusano 7d535a
kusano 7d535a
    INFO   - INTEGER   
kusano 7d535a
             Error code.  On exit, INFO will be set to one of the   
kusano 7d535a
             following values:   
kusano 7d535a
               0 => normal return   
kusano 7d535a
              -1 => M negative or unequal to N and SYM='S', 'H', or 'P'   
kusano 7d535a
              -2 => N negative   
kusano 7d535a
              -3 => DIST illegal string   
kusano 7d535a
              -5 => SYM illegal string   
kusano 7d535a
              -7 => MODE not in range -6 to 6   
kusano 7d535a
              -8 => COND less than 1.0, and MODE neither -6, 0 nor 6   
kusano 7d535a
             -10 => KL negative   
kusano 7d535a
             -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL 
kusano 7d535a
  
kusano 7d535a
             -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; 
kusano 7d535a
  
kusano 7d535a
                    or PACK='C' or 'Q' and SYM='N' and KL is not zero;   
kusano 7d535a
                    or PACK='R' or 'B' and SYM='N' and KU is not zero;   
kusano 7d535a
                    or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not 
kusano 7d535a
  
kusano 7d535a
                    N.   
kusano 7d535a
             -14 => LDA is less than M, or PACK='Z' and LDA is less than 
kusano 7d535a
  
kusano 7d535a
                    MIN(KU,N-1) + MIN(KL,M-1) + 1.   
kusano 7d535a
              1  => Error return from SLATM1   
kusano 7d535a
              2  => Cannot scale to DMAX (max. sing. value is 0)   
kusano 7d535a
              3  => Error return from SLAGGE or SLAGSY   
kusano 7d535a
kusano 7d535a
    ===================================================================== 
kusano 7d535a
  
kusano 7d535a
kusano 7d535a
kusano 7d535a
       1)      Decode and Test the input parameters.   
kusano 7d535a
               Initialize flags & seed.   
kusano 7d535a
kusano 7d535a
       Parameter adjustments */
kusano 7d535a
    --iseed;
kusano 7d535a
    --d;
kusano 7d535a
    a_dim1 = *lda;
kusano 7d535a
    a_offset = a_dim1 + 1;
kusano 7d535a
    a -= a_offset;
kusano 7d535a
    --work;
kusano 7d535a
kusano 7d535a
    /* Function Body */
kusano 7d535a
    *info = 0;
kusano 7d535a
kusano 7d535a
/*     Quick return if possible */
kusano 7d535a
kusano 7d535a
    if (*m == 0 || *n == 0) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Decode DIST */
kusano 7d535a
kusano 7d535a
    if (lsame_(dist, "U")) {
kusano 7d535a
	idist = 1;
kusano 7d535a
    } else if (lsame_(dist, "S")) {
kusano 7d535a
	idist = 2;
kusano 7d535a
    } else if (lsame_(dist, "N")) {
kusano 7d535a
	idist = 3;
kusano 7d535a
    } else {
kusano 7d535a
	idist = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Decode SYM */
kusano 7d535a
kusano 7d535a
    if (lsame_(sym, "N")) {
kusano 7d535a
	isym = 1;
kusano 7d535a
	irsign = 0;
kusano 7d535a
    } else if (lsame_(sym, "P")) {
kusano 7d535a
	isym = 2;
kusano 7d535a
	irsign = 0;
kusano 7d535a
    } else if (lsame_(sym, "S")) {
kusano 7d535a
	isym = 2;
kusano 7d535a
	irsign = 1;
kusano 7d535a
    } else if (lsame_(sym, "H")) {
kusano 7d535a
	isym = 2;
kusano 7d535a
	irsign = 1;
kusano 7d535a
    } else {
kusano 7d535a
	isym = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Decode PACK */
kusano 7d535a
kusano 7d535a
    isympk = 0;
kusano 7d535a
    if (lsame_(pack, "N")) {
kusano 7d535a
	ipack = 0;
kusano 7d535a
    } else if (lsame_(pack, "U")) {
kusano 7d535a
	ipack = 1;
kusano 7d535a
	isympk = 1;
kusano 7d535a
    } else if (lsame_(pack, "L")) {
kusano 7d535a
	ipack = 2;
kusano 7d535a
	isympk = 1;
kusano 7d535a
    } else if (lsame_(pack, "C")) {
kusano 7d535a
	ipack = 3;
kusano 7d535a
	isympk = 2;
kusano 7d535a
    } else if (lsame_(pack, "R")) {
kusano 7d535a
	ipack = 4;
kusano 7d535a
	isympk = 3;
kusano 7d535a
    } else if (lsame_(pack, "B")) {
kusano 7d535a
	ipack = 5;
kusano 7d535a
	isympk = 3;
kusano 7d535a
    } else if (lsame_(pack, "Q")) {
kusano 7d535a
	ipack = 6;
kusano 7d535a
	isympk = 2;
kusano 7d535a
    } else if (lsame_(pack, "Z")) {
kusano 7d535a
	ipack = 7;
kusano 7d535a
    } else {
kusano 7d535a
	ipack = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set certain internal parameters */
kusano 7d535a
kusano 7d535a
    mnmin = min(*m,*n);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
    i__1 = *kl, i__2 = *m - 1;
kusano 7d535a
    llb = min(i__1,i__2);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
    i__1 = *ku, i__2 = *n - 1;
kusano 7d535a
    uub = min(i__1,i__2);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
    i__1 = *m, i__2 = *n + llb;
kusano 7d535a
    mr = min(i__1,i__2);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
    i__1 = *n, i__2 = *m + uub;
kusano 7d535a
    nc = min(i__1,i__2);
kusano 7d535a
kusano 7d535a
    if (ipack == 5 || ipack == 6) {
kusano 7d535a
	minlda = uub + 1;
kusano 7d535a
    } else if (ipack == 7) {
kusano 7d535a
	minlda = llb + uub + 1;
kusano 7d535a
    } else {
kusano 7d535a
	minlda = *m;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Use Givens rotation method if bandwidth small enough,   
kusano 7d535a
       or if LDA is too small to store the matrix unpacked. */
kusano 7d535a
kusano 7d535a
    givens = FALSE_;
kusano 7d535a
    if (isym == 1) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	i__1 = 1, i__2 = mr + nc;
kusano 7d535a
	if ((real) (llb + uub) < (real) max(i__1,i__2) * .3f) {
kusano 7d535a
	    givens = TRUE_;
kusano 7d535a
	}
kusano 7d535a
    } else {
kusano 7d535a
	if (llb << 1 < *m) {
kusano 7d535a
	    givens = TRUE_;
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
    if (*lda < *m && *lda >= minlda) {
kusano 7d535a
	givens = TRUE_;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set INFO if an error */
kusano 7d535a
kusano 7d535a
    if (*m < 0) {
kusano 7d535a
	*info = -1;
kusano 7d535a
    } else if (*m != *n && isym != 1) {
kusano 7d535a
	*info = -1;
kusano 7d535a
    } else if (*n < 0) {
kusano 7d535a
	*info = -2;
kusano 7d535a
    } else if (idist == -1) {
kusano 7d535a
	*info = -3;
kusano 7d535a
    } else if (isym == -1) {
kusano 7d535a
	*info = -5;
kusano 7d535a
    } else if (abs(*mode) > 6) {
kusano 7d535a
	*info = -7;
kusano 7d535a
    } else if (*mode != 0 && abs(*mode) != 6 && *cond < 1.f) {
kusano 7d535a
	*info = -8;
kusano 7d535a
    } else if (*kl < 0) {
kusano 7d535a
	*info = -10;
kusano 7d535a
    } else if (*ku < 0 || isym != 1 && *kl != *ku) {
kusano 7d535a
	*info = -11;
kusano 7d535a
    } else if (ipack == -1 || isympk == 1 && isym == 1 || isympk == 2 && isym 
kusano 7d535a
	    == 1 && *kl > 0 || isympk == 3 && isym == 1 && *ku > 0 || isympk 
kusano 7d535a
	    != 0 && *m != *n) {
kusano 7d535a
	*info = -12;
kusano 7d535a
    } else if (*lda < max(1,minlda)) {
kusano 7d535a
	*info = -14;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (*info != 0) {
kusano 7d535a
	i__1 = -(*info);
kusano 7d535a
	xerbla_("SLATMS", &i__1);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Initialize random number generator */
kusano 7d535a
kusano 7d535a
    for (i = 1; i <= 4; ++i) {
kusano 7d535a
	iseed[i] = (i__1 = iseed[i], abs(i__1)) % 4096;
kusano 7d535a
/* L10: */
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (iseed[4] % 2 != 1) {
kusano 7d535a
	++iseed[4];
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     2)      Set up D  if indicated.   
kusano 7d535a
kusano 7d535a
               Compute D according to COND and MODE */
kusano 7d535a
kusano 7d535a
    slatm1_(mode, cond, &irsign, &idist, &iseed[1], &d[1], &mnmin, &iinfo);
kusano 7d535a
    if (iinfo != 0) {
kusano 7d535a
	*info = 1;
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Choose Top-Down if D is (apparently) increasing,   
kusano 7d535a
       Bottom-Up if D is (apparently) decreasing. */
kusano 7d535a
kusano 7d535a
    if (dabs(d[1]) <= (r__1 = d[mnmin], dabs(r__1))) {
kusano 7d535a
	topdwn = TRUE_;
kusano 7d535a
    } else {
kusano 7d535a
	topdwn = FALSE_;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (*mode != 0 && abs(*mode) != 6) {
kusano 7d535a
kusano 7d535a
/*        Scale by DMAX */
kusano 7d535a
kusano 7d535a
	temp = dabs(d[1]);
kusano 7d535a
	i__1 = mnmin;
kusano 7d535a
	for (i = 2; i <= i__1; ++i) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    r__2 = temp, r__3 = (r__1 = d[i], dabs(r__1));
kusano 7d535a
	    temp = dmax(r__2,r__3);
kusano 7d535a
/* L20: */
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (temp > 0.f) {
kusano 7d535a
	    alpha = *dmax__ / temp;
kusano 7d535a
	} else {
kusano 7d535a
	    *info = 2;
kusano 7d535a
	    return 0;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	sscal_(&mnmin, &alpha, &d[1], &c__1);
kusano 7d535a
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     3)      Generate Banded Matrix using Givens rotations.   
kusano 7d535a
               Also the special case of UUB=LLB=0   
kusano 7d535a
kusano 7d535a
                 Compute Addressing constants to cover all   
kusano 7d535a
                 storage formats.  Whether GE, SY, GB, or SB,   
kusano 7d535a
                 upper or lower triangle or both,   
kusano 7d535a
                 the (i,j)-th element is in   
kusano 7d535a
                 A( i - ISKEW*j + IOFFST, j ) */
kusano 7d535a
kusano 7d535a
    if (ipack > 4) {
kusano 7d535a
	ilda = *lda - 1;
kusano 7d535a
	iskew = 1;
kusano 7d535a
	if (ipack > 5) {
kusano 7d535a
	    ioffst = uub + 1;
kusano 7d535a
	} else {
kusano 7d535a
	    ioffst = 1;
kusano 7d535a
	}
kusano 7d535a
    } else {
kusano 7d535a
	ilda = *lda;
kusano 7d535a
	iskew = 0;
kusano 7d535a
	ioffst = 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     IPACKG is the format that the matrix is generated in. If this is   
kusano 7d535a
       different from IPACK, then the matrix must be repacked at the   
kusano 7d535a
       end.  It also signals how to compute the norm, for scaling. */
kusano 7d535a
kusano 7d535a
    ipackg = 0;
kusano 7d535a
    slaset_("Full", lda, n, &c_b22, &c_b22, &a[a_offset], lda);
kusano 7d535a
kusano 7d535a
/*     Diagonal Matrix -- We are done, unless it   
kusano 7d535a
       is to be stored SP/PP/TP (PACK='R' or 'C') */
kusano 7d535a
kusano 7d535a
    if (llb == 0 && uub == 0) {
kusano 7d535a
	i__1 = ilda + 1;
kusano 7d535a
	scopy_(&mnmin, &d[1], &c__1, &a[1 - iskew + ioffst + a_dim1], &i__1);
kusano 7d535a
	if (ipack <= 2 || ipack >= 5) {
kusano 7d535a
	    ipackg = ipack;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else if (givens) {
kusano 7d535a
kusano 7d535a
/*        Check whether to use Givens rotations,   
kusano 7d535a
          Householder transformations, or nothing. */
kusano 7d535a
kusano 7d535a
	if (isym == 1) {
kusano 7d535a
kusano 7d535a
/*           Non-symmetric -- A = U D V */
kusano 7d535a
kusano 7d535a
	    if (ipack > 4) {
kusano 7d535a
		ipackg = ipack;
kusano 7d535a
	    } else {
kusano 7d535a
		ipackg = 0;
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	    i__1 = ilda + 1;
kusano 7d535a
	    scopy_(&mnmin, &d[1], &c__1, &a[1 - iskew + ioffst + a_dim1], &
kusano 7d535a
		    i__1);
kusano 7d535a
kusano 7d535a
	    if (topdwn) {
kusano 7d535a
		jkl = 0;
kusano 7d535a
		i__1 = uub;
kusano 7d535a
		for (jku = 1; jku <= i__1; ++jku) {
kusano 7d535a
kusano 7d535a
/*                 Transform from bandwidth JKL, JKU-1 to 
kusano 7d535a
JKL, JKU   
kusano 7d535a
kusano 7d535a
                   Last row actually rotated is M   
kusano 7d535a
                   Last column actually rotated is MIN( M+
kusano 7d535a
JKU, N )   
kusano 7d535a
kusano 7d535a
   Computing MIN */
kusano 7d535a
		    i__3 = *m + jku;
kusano 7d535a
		    i__2 = min(i__3,*n) + jkl - 1;
kusano 7d535a
		    for (jr = 1; jr <= i__2; ++jr) {
kusano 7d535a
			extra = 0.f;
kusano 7d535a
			angle = slarnd_(&c__1, &iseed[1]) * 
kusano 7d535a
				6.2831853071795864769252867663f;
kusano 7d535a
			c = cos(angle);
kusano 7d535a
			s = sin(angle);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__3 = 1, i__4 = jr - jkl;
kusano 7d535a
			icol = max(i__3,i__4);
kusano 7d535a
			if (jr < *m) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__3 = *n, i__4 = jr + jku;
kusano 7d535a
			    il = min(i__3,i__4) + 1 - icol;
kusano 7d535a
			    L__1 = jr > jkl;
kusano 7d535a
			    slarot_(&c_true, &L__1, &c_false, &il, &c, &s, &a[
kusano 7d535a
				    jr - iskew * icol + ioffst + icol * 
kusano 7d535a
				    a_dim1], &ilda, &extra, &dummy);
kusano 7d535a
			}
kusano 7d535a
kusano 7d535a
/*                    Chase "EXTRA" back up */
kusano 7d535a
kusano 7d535a
			ir = jr;
kusano 7d535a
			ic = icol;
kusano 7d535a
			i__3 = -jkl - jku;
kusano 7d535a
			for (jch = jr - jkl; i__3 < 0 ? jch >= 1 : jch <= 1; 
kusano 7d535a
				jch += i__3) {
kusano 7d535a
			    if (ir < *m) {
kusano 7d535a
				slartg_(&a[ir + 1 - iskew * (ic + 1) + ioffst 
kusano 7d535a
					+ (ic + 1) * a_dim1], &extra, &c, &s, 
kusano 7d535a
					&dummy);
kusano 7d535a
			    }
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			    i__4 = 1, i__5 = jch - jku;
kusano 7d535a
			    irow = max(i__4,i__5);
kusano 7d535a
			    il = ir + 2 - irow;
kusano 7d535a
			    temp = 0.f;
kusano 7d535a
			    iltemp = jch > jku;
kusano 7d535a
			    r__1 = -(doublereal)s;
kusano 7d535a
			    slarot_(&c_false, &iltemp, &c_true, &il, &c, &
kusano 7d535a
				    r__1, &a[irow - iskew * ic + ioffst + ic *
kusano 7d535a
				     a_dim1], &ilda, &temp, &extra);
kusano 7d535a
			    if (iltemp) {
kusano 7d535a
				slartg_(&a[irow + 1 - iskew * (ic + 1) + 
kusano 7d535a
					ioffst + (ic + 1) * a_dim1], &temp, &
kusano 7d535a
					c, &s, &dummy);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
				i__4 = 1, i__5 = jch - jku - jkl;
kusano 7d535a
				icol = max(i__4,i__5);
kusano 7d535a
				il = ic + 2 - icol;
kusano 7d535a
				extra = 0.f;
kusano 7d535a
				L__1 = jch > jku + jkl;
kusano 7d535a
				r__1 = -(doublereal)s;
kusano 7d535a
				slarot_(&c_true, &L__1, &c_true, &il, &c, &
kusano 7d535a
					r__1, &a[irow - iskew * icol + ioffst 
kusano 7d535a
					+ icol * a_dim1], &ilda, &extra, &
kusano 7d535a
					temp);
kusano 7d535a
				ic = icol;
kusano 7d535a
				ir = irow;
kusano 7d535a
			    }
kusano 7d535a
/* L30: */
kusano 7d535a
			}
kusano 7d535a
/* L40: */
kusano 7d535a
		    }
kusano 7d535a
/* L50: */
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
		jku = uub;
kusano 7d535a
		i__1 = llb;
kusano 7d535a
		for (jkl = 1; jkl <= i__1; ++jkl) {
kusano 7d535a
kusano 7d535a
/*                 Transform from bandwidth JKL-1, JKU to 
kusano 7d535a
JKL, JKU   
kusano 7d535a
kusano 7d535a
   Computing MIN */
kusano 7d535a
		    i__3 = *n + jkl;
kusano 7d535a
		    i__2 = min(i__3,*m) + jku - 1;
kusano 7d535a
		    for (jc = 1; jc <= i__2; ++jc) {
kusano 7d535a
			extra = 0.f;
kusano 7d535a
			angle = slarnd_(&c__1, &iseed[1]) * 
kusano 7d535a
				6.2831853071795864769252867663f;
kusano 7d535a
			c = cos(angle);
kusano 7d535a
			s = sin(angle);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__3 = 1, i__4 = jc - jku;
kusano 7d535a
			irow = max(i__3,i__4);
kusano 7d535a
			if (jc < *n) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__3 = *m, i__4 = jc + jkl;
kusano 7d535a
			    il = min(i__3,i__4) + 1 - irow;
kusano 7d535a
			    L__1 = jc > jku;
kusano 7d535a
			    slarot_(&c_false, &L__1, &c_false, &il, &c, &s, &
kusano 7d535a
				    a[irow - iskew * jc + ioffst + jc * 
kusano 7d535a
				    a_dim1], &ilda, &extra, &dummy);
kusano 7d535a
			}
kusano 7d535a
kusano 7d535a
/*                    Chase "EXTRA" back up */
kusano 7d535a
kusano 7d535a
			ic = jc;
kusano 7d535a
			ir = irow;
kusano 7d535a
			i__3 = -jkl - jku;
kusano 7d535a
			for (jch = jc - jku; i__3 < 0 ? jch >= 1 : jch <= 1; 
kusano 7d535a
				jch += i__3) {
kusano 7d535a
			    if (ic < *n) {
kusano 7d535a
				slartg_(&a[ir + 1 - iskew * (ic + 1) + ioffst 
kusano 7d535a
					+ (ic + 1) * a_dim1], &extra, &c, &s, 
kusano 7d535a
					&dummy);
kusano 7d535a
			    }
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			    i__4 = 1, i__5 = jch - jkl;
kusano 7d535a
			    icol = max(i__4,i__5);
kusano 7d535a
			    il = ic + 2 - icol;
kusano 7d535a
			    temp = 0.f;
kusano 7d535a
			    iltemp = jch > jkl;
kusano 7d535a
			    r__1 = -(doublereal)s;
kusano 7d535a
			    slarot_(&c_true, &iltemp, &c_true, &il, &c, &r__1,
kusano 7d535a
				     &a[ir - iskew * icol + ioffst + icol * 
kusano 7d535a
				    a_dim1], &ilda, &temp, &extra);
kusano 7d535a
			    if (iltemp) {
kusano 7d535a
				slartg_(&a[ir + 1 - iskew * (icol + 1) + 
kusano 7d535a
					ioffst + (icol + 1) * a_dim1], &temp, 
kusano 7d535a
					&c, &s, &dummy);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
				i__4 = 1, i__5 = jch - jkl - jku;
kusano 7d535a
				irow = max(i__4,i__5);
kusano 7d535a
				il = ir + 2 - irow;
kusano 7d535a
				extra = 0.f;
kusano 7d535a
				L__1 = jch > jkl + jku;
kusano 7d535a
				r__1 = -(doublereal)s;
kusano 7d535a
				slarot_(&c_false, &L__1, &c_true, &il, &c, &
kusano 7d535a
					r__1, &a[irow - iskew * icol + ioffst 
kusano 7d535a
					+ icol * a_dim1], &ilda, &extra, &
kusano 7d535a
					temp);
kusano 7d535a
				ic = icol;
kusano 7d535a
				ir = irow;
kusano 7d535a
			    }
kusano 7d535a
/* L60: */
kusano 7d535a
			}
kusano 7d535a
/* L70: */
kusano 7d535a
		    }
kusano 7d535a
/* L80: */
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
	    } else {
kusano 7d535a
kusano 7d535a
/*              Bottom-Up -- Start at the bottom right. */
kusano 7d535a
kusano 7d535a
		jkl = 0;
kusano 7d535a
		i__1 = uub;
kusano 7d535a
		for (jku = 1; jku <= i__1; ++jku) {
kusano 7d535a
kusano 7d535a
/*                 Transform from bandwidth JKL, JKU-1 to 
kusano 7d535a
JKL, JKU   
kusano 7d535a
kusano 7d535a
                   First row actually rotated is M   
kusano 7d535a
                   First column actually rotated is MIN( M
kusano 7d535a
+JKU, N )   
kusano 7d535a
kusano 7d535a
   Computing MIN */
kusano 7d535a
		    i__2 = *m, i__3 = *n + jkl;
kusano 7d535a
		    iendch = min(i__2,i__3) - 1;
kusano 7d535a
/* Computing MIN */
kusano 7d535a
		    i__2 = *m + jku;
kusano 7d535a
		    i__3 = 1 - jkl;
kusano 7d535a
		    for (jc = min(i__2,*n) - 1; jc >= i__3; --jc) {
kusano 7d535a
			extra = 0.f;
kusano 7d535a
			angle = slarnd_(&c__1, &iseed[1]) * 
kusano 7d535a
				6.2831853071795864769252867663f;
kusano 7d535a
			c = cos(angle);
kusano 7d535a
			s = sin(angle);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__2 = 1, i__4 = jc - jku + 1;
kusano 7d535a
			irow = max(i__2,i__4);
kusano 7d535a
			if (jc > 0) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__2 = *m, i__4 = jc + jkl + 1;
kusano 7d535a
			    il = min(i__2,i__4) + 1 - irow;
kusano 7d535a
			    L__1 = jc + jkl < *m;
kusano 7d535a
			    slarot_(&c_false, &c_false, &L__1, &il, &c, &s, &
kusano 7d535a
				    a[irow - iskew * jc + ioffst + jc * 
kusano 7d535a
				    a_dim1], &ilda, &dummy, &extra);
kusano 7d535a
			}
kusano 7d535a
kusano 7d535a
/*                    Chase "EXTRA" back down */
kusano 7d535a
kusano 7d535a
			ic = jc;
kusano 7d535a
			i__2 = iendch;
kusano 7d535a
			i__4 = jkl + jku;
kusano 7d535a
			for (jch = jc + jkl; i__4 < 0 ? jch >= i__2 : jch <= 
kusano 7d535a
				i__2; jch += i__4) {
kusano 7d535a
			    ilextr = ic > 0;
kusano 7d535a
			    if (ilextr) {
kusano 7d535a
				slartg_(&a[jch - iskew * ic + ioffst + ic * 
kusano 7d535a
					a_dim1], &extra, &c, &s, &dummy);
kusano 7d535a
			    }
kusano 7d535a
			    ic = max(1,ic);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__5 = *n - 1, i__6 = jch + jku;
kusano 7d535a
			    icol = min(i__5,i__6);
kusano 7d535a
			    iltemp = jch + jku < *n;
kusano 7d535a
			    temp = 0.f;
kusano 7d535a
			    i__5 = icol + 2 - ic;
kusano 7d535a
			    slarot_(&c_true, &ilextr, &iltemp, &i__5, &c, &s, 
kusano 7d535a
				    &a[jch - iskew * ic + ioffst + ic * 
kusano 7d535a
				    a_dim1], &ilda, &extra, &temp);
kusano 7d535a
			    if (iltemp) {
kusano 7d535a
				slartg_(&a[jch - iskew * icol + ioffst + icol 
kusano 7d535a
					* a_dim1], &temp, &c, &s, &dummy);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
				i__5 = iendch, i__6 = jch + jkl + jku;
kusano 7d535a
				il = min(i__5,i__6) + 2 - jch;
kusano 7d535a
				extra = 0.f;
kusano 7d535a
				L__1 = jch + jkl + jku <= iendch;
kusano 7d535a
				slarot_(&c_false, &c_true, &L__1, &il, &c, &s,
kusano 7d535a
					 &a[jch - iskew * icol + ioffst + 
kusano 7d535a
					icol * a_dim1], &ilda, &temp, &extra);
kusano 7d535a
				ic = icol;
kusano 7d535a
			    }
kusano 7d535a
/* L90: */
kusano 7d535a
			}
kusano 7d535a
/* L100: */
kusano 7d535a
		    }
kusano 7d535a
/* L110: */
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
		jku = uub;
kusano 7d535a
		i__1 = llb;
kusano 7d535a
		for (jkl = 1; jkl <= i__1; ++jkl) {
kusano 7d535a
kusano 7d535a
/*                 Transform from bandwidth JKL-1, JKU to 
kusano 7d535a
JKL, JKU   
kusano 7d535a
kusano 7d535a
                   First row actually rotated is MIN( N+JK
kusano 7d535a
L, M )   
kusano 7d535a
                   First column actually rotated is N   
kusano 7d535a
kusano 7d535a
   Computing MIN */
kusano 7d535a
		    i__3 = *n, i__4 = *m + jku;
kusano 7d535a
		    iendch = min(i__3,i__4) - 1;
kusano 7d535a
/* Computing MIN */
kusano 7d535a
		    i__3 = *n + jkl;
kusano 7d535a
		    i__4 = 1 - jku;
kusano 7d535a
		    for (jr = min(i__3,*m) - 1; jr >= i__4; --jr) {
kusano 7d535a
			extra = 0.f;
kusano 7d535a
			angle = slarnd_(&c__1, &iseed[1]) * 
kusano 7d535a
				6.2831853071795864769252867663f;
kusano 7d535a
			c = cos(angle);
kusano 7d535a
			s = sin(angle);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__3 = 1, i__2 = jr - jkl + 1;
kusano 7d535a
			icol = max(i__3,i__2);
kusano 7d535a
			if (jr > 0) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__3 = *n, i__2 = jr + jku + 1;
kusano 7d535a
			    il = min(i__3,i__2) + 1 - icol;
kusano 7d535a
			    L__1 = jr + jku < *n;
kusano 7d535a
			    slarot_(&c_true, &c_false, &L__1, &il, &c, &s, &a[
kusano 7d535a
				    jr - iskew * icol + ioffst + icol * 
kusano 7d535a
				    a_dim1], &ilda, &dummy, &extra);
kusano 7d535a
			}
kusano 7d535a
kusano 7d535a
/*                    Chase "EXTRA" back down */
kusano 7d535a
kusano 7d535a
			ir = jr;
kusano 7d535a
			i__3 = iendch;
kusano 7d535a
			i__2 = jkl + jku;
kusano 7d535a
			for (jch = jr + jku; i__2 < 0 ? jch >= i__3 : jch <= 
kusano 7d535a
				i__3; jch += i__2) {
kusano 7d535a
			    ilextr = ir > 0;
kusano 7d535a
			    if (ilextr) {
kusano 7d535a
				slartg_(&a[ir - iskew * jch + ioffst + jch * 
kusano 7d535a
					a_dim1], &extra, &c, &s, &dummy);
kusano 7d535a
			    }
kusano 7d535a
			    ir = max(1,ir);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__5 = *m - 1, i__6 = jch + jkl;
kusano 7d535a
			    irow = min(i__5,i__6);
kusano 7d535a
			    iltemp = jch + jkl < *m;
kusano 7d535a
			    temp = 0.f;
kusano 7d535a
			    i__5 = irow + 2 - ir;
kusano 7d535a
			    slarot_(&c_false, &ilextr, &iltemp, &i__5, &c, &s,
kusano 7d535a
				     &a[ir - iskew * jch + ioffst + jch * 
kusano 7d535a
				    a_dim1], &ilda, &extra, &temp);
kusano 7d535a
			    if (iltemp) {
kusano 7d535a
				slartg_(&a[irow - iskew * jch + ioffst + jch *
kusano 7d535a
					 a_dim1], &temp, &c, &s, &dummy);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
				i__5 = iendch, i__6 = jch + jkl + jku;
kusano 7d535a
				il = min(i__5,i__6) + 2 - jch;
kusano 7d535a
				extra = 0.f;
kusano 7d535a
				L__1 = jch + jkl + jku <= iendch;
kusano 7d535a
				slarot_(&c_true, &c_true, &L__1, &il, &c, &s, 
kusano 7d535a
					&a[irow - iskew * jch + ioffst + jch *
kusano 7d535a
					 a_dim1], &ilda, &temp, &extra);
kusano 7d535a
				ir = irow;
kusano 7d535a
			    }
kusano 7d535a
/* L120: */
kusano 7d535a
			}
kusano 7d535a
/* L130: */
kusano 7d535a
		    }
kusano 7d535a
/* L140: */
kusano 7d535a
		}
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	} else {
kusano 7d535a
kusano 7d535a
/*           Symmetric -- A = U D U' */
kusano 7d535a
kusano 7d535a
	    ipackg = ipack;
kusano 7d535a
	    ioffg = ioffst;
kusano 7d535a
kusano 7d535a
	    if (topdwn) {
kusano 7d535a
kusano 7d535a
/*              Top-Down -- Generate Upper triangle only */
kusano 7d535a
kusano 7d535a
		if (ipack >= 5) {
kusano 7d535a
		    ipackg = 6;
kusano 7d535a
		    ioffg = uub + 1;
kusano 7d535a
		} else {
kusano 7d535a
		    ipackg = 1;
kusano 7d535a
		}
kusano 7d535a
		i__1 = ilda + 1;
kusano 7d535a
		scopy_(&mnmin, &d[1], &c__1, &a[1 - iskew + ioffg + a_dim1], &
kusano 7d535a
			i__1);
kusano 7d535a
kusano 7d535a
		i__1 = uub;
kusano 7d535a
		for (k = 1; k <= i__1; ++k) {
kusano 7d535a
		    i__4 = *n - 1;
kusano 7d535a
		    for (jc = 1; jc <= i__4; ++jc) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__2 = 1, i__3 = jc - k;
kusano 7d535a
			irow = max(i__2,i__3);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			i__2 = jc + 1, i__3 = k + 2;
kusano 7d535a
			il = min(i__2,i__3);
kusano 7d535a
			extra = 0.f;
kusano 7d535a
			temp = a[jc - iskew * (jc + 1) + ioffg + (jc + 1) * 
kusano 7d535a
				a_dim1];
kusano 7d535a
			angle = slarnd_(&c__1, &iseed[1]) * 
kusano 7d535a
				6.2831853071795864769252867663f;
kusano 7d535a
			c = cos(angle);
kusano 7d535a
			s = sin(angle);
kusano 7d535a
			L__1 = jc > k;
kusano 7d535a
			slarot_(&c_false, &L__1, &c_true, &il, &c, &s, &a[
kusano 7d535a
				irow - iskew * jc + ioffg + jc * a_dim1], &
kusano 7d535a
				ilda, &extra, &temp);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			i__3 = k, i__5 = *n - jc;
kusano 7d535a
			i__2 = min(i__3,i__5) + 1;
kusano 7d535a
			slarot_(&c_true, &c_true, &c_false, &i__2, &c, &s, &a[
kusano 7d535a
				(1 - iskew) * jc + ioffg + jc * a_dim1], &
kusano 7d535a
				ilda, &temp, &dummy);
kusano 7d535a
kusano 7d535a
/*                    Chase EXTRA back up the matrix 
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
			icol = jc;
kusano 7d535a
			i__2 = -k;
kusano 7d535a
			for (jch = jc - k; i__2 < 0 ? jch >= 1 : jch <= 1; 
kusano 7d535a
				jch += i__2) {
kusano 7d535a
			    slartg_(&a[jch + 1 - iskew * (icol + 1) + ioffg + 
kusano 7d535a
				    (icol + 1) * a_dim1], &extra, &c, &s, &
kusano 7d535a
				    dummy);
kusano 7d535a
			    temp = a[jch - iskew * (jch + 1) + ioffg + (jch + 
kusano 7d535a
				    1) * a_dim1];
kusano 7d535a
			    i__3 = k + 2;
kusano 7d535a
			    r__1 = -(doublereal)s;
kusano 7d535a
			    slarot_(&c_true, &c_true, &c_true, &i__3, &c, &
kusano 7d535a
				    r__1, &a[(1 - iskew) * jch + ioffg + jch *
kusano 7d535a
				     a_dim1], &ilda, &temp, &extra);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			    i__3 = 1, i__5 = jch - k;
kusano 7d535a
			    irow = max(i__3,i__5);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__3 = jch + 1, i__5 = k + 2;
kusano 7d535a
			    il = min(i__3,i__5);
kusano 7d535a
			    extra = 0.f;
kusano 7d535a
			    L__1 = jch > k;
kusano 7d535a
			    r__1 = -(doublereal)s;
kusano 7d535a
			    slarot_(&c_false, &L__1, &c_true, &il, &c, &r__1, 
kusano 7d535a
				    &a[irow - iskew * jch + ioffg + jch * 
kusano 7d535a
				    a_dim1], &ilda, &extra, &temp);
kusano 7d535a
			    icol = jch;
kusano 7d535a
/* L150: */
kusano 7d535a
			}
kusano 7d535a
/* L160: */
kusano 7d535a
		    }
kusano 7d535a
/* L170: */
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
/*              If we need lower triangle, copy from upper. No
kusano 7d535a
te that   
kusano 7d535a
                the order of copying is chosen to work for 'q'
kusano 7d535a
 -> 'b' */
kusano 7d535a
kusano 7d535a
		if (ipack != ipackg && ipack != 3) {
kusano 7d535a
		    i__1 = *n;
kusano 7d535a
		    for (jc = 1; jc <= i__1; ++jc) {
kusano 7d535a
			irow = ioffst - iskew * jc;
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			i__2 = *n, i__3 = jc + uub;
kusano 7d535a
			i__4 = min(i__2,i__3);
kusano 7d535a
			for (jr = jc; jr <= i__4; ++jr) {
kusano 7d535a
			    a[jr + irow + jc * a_dim1] = a[jc - iskew * jr + 
kusano 7d535a
				    ioffg + jr * a_dim1];
kusano 7d535a
/* L180: */
kusano 7d535a
			}
kusano 7d535a
/* L190: */
kusano 7d535a
		    }
kusano 7d535a
		    if (ipack == 5) {
kusano 7d535a
			i__1 = *n;
kusano 7d535a
			for (jc = *n - uub + 1; jc <= i__1; ++jc) {
kusano 7d535a
			    i__4 = uub + 1;
kusano 7d535a
			    for (jr = *n + 2 - jc; jr <= i__4; ++jr) {
kusano 7d535a
				a[jr + jc * a_dim1] = 0.f;
kusano 7d535a
/* L200: */
kusano 7d535a
			    }
kusano 7d535a
/* L210: */
kusano 7d535a
			}
kusano 7d535a
		    }
kusano 7d535a
		    if (ipackg == 6) {
kusano 7d535a
			ipackg = ipack;
kusano 7d535a
		    } else {
kusano 7d535a
			ipackg = 0;
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
	    } else {
kusano 7d535a
kusano 7d535a
/*              Bottom-Up -- Generate Lower triangle only */
kusano 7d535a
kusano 7d535a
		if (ipack >= 5) {
kusano 7d535a
		    ipackg = 5;
kusano 7d535a
		    if (ipack == 6) {
kusano 7d535a
			ioffg = 1;
kusano 7d535a
		    }
kusano 7d535a
		} else {
kusano 7d535a
		    ipackg = 2;
kusano 7d535a
		}
kusano 7d535a
		i__1 = ilda + 1;
kusano 7d535a
		scopy_(&mnmin, &d[1], &c__1, &a[1 - iskew + ioffg + a_dim1], &
kusano 7d535a
			i__1);
kusano 7d535a
kusano 7d535a
		i__1 = uub;
kusano 7d535a
		for (k = 1; k <= i__1; ++k) {
kusano 7d535a
		    for (jc = *n - 1; jc >= 1; --jc) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			i__4 = *n + 1 - jc, i__2 = k + 2;
kusano 7d535a
			il = min(i__4,i__2);
kusano 7d535a
			extra = 0.f;
kusano 7d535a
			temp = a[(1 - iskew) * jc + 1 + ioffg + jc * a_dim1];
kusano 7d535a
			angle = slarnd_(&c__1, &iseed[1]) * 
kusano 7d535a
				6.2831853071795864769252867663f;
kusano 7d535a
			c = cos(angle);
kusano 7d535a
			s = -(doublereal)sin(angle);
kusano 7d535a
			L__1 = *n - jc > k;
kusano 7d535a
			slarot_(&c_false, &c_true, &L__1, &il, &c, &s, &a[(1 
kusano 7d535a
				- iskew) * jc + ioffg + jc * a_dim1], &ilda, &
kusano 7d535a
				temp, &extra);
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__4 = 1, i__2 = jc - k + 1;
kusano 7d535a
			icol = max(i__4,i__2);
kusano 7d535a
			i__4 = jc + 2 - icol;
kusano 7d535a
			slarot_(&c_true, &c_false, &c_true, &i__4, &c, &s, &a[
kusano 7d535a
				jc - iskew * icol + ioffg + icol * a_dim1], &
kusano 7d535a
				ilda, &dummy, &temp);
kusano 7d535a
kusano 7d535a
/*                    Chase EXTRA back down the matrix
kusano 7d535a
 */
kusano 7d535a
kusano 7d535a
			icol = jc;
kusano 7d535a
			i__4 = *n - 1;
kusano 7d535a
			i__2 = k;
kusano 7d535a
			for (jch = jc + k; i__2 < 0 ? jch >= i__4 : jch <= 
kusano 7d535a
				i__4; jch += i__2) {
kusano 7d535a
			    slartg_(&a[jch - iskew * icol + ioffg + icol * 
kusano 7d535a
				    a_dim1], &extra, &c, &s, &dummy);
kusano 7d535a
			    temp = a[(1 - iskew) * jch + 1 + ioffg + jch * 
kusano 7d535a
				    a_dim1];
kusano 7d535a
			    i__3 = k + 2;
kusano 7d535a
			    slarot_(&c_true, &c_true, &c_true, &i__3, &c, &s, 
kusano 7d535a
				    &a[jch - iskew * icol + ioffg + icol * 
kusano 7d535a
				    a_dim1], &ilda, &extra, &temp);
kusano 7d535a
/* Computing MIN */
kusano 7d535a
			    i__3 = *n + 1 - jch, i__5 = k + 2;
kusano 7d535a
			    il = min(i__3,i__5);
kusano 7d535a
			    extra = 0.f;
kusano 7d535a
			    L__1 = *n - jch > k;
kusano 7d535a
			    slarot_(&c_false, &c_true, &L__1, &il, &c, &s, &a[
kusano 7d535a
				    (1 - iskew) * jch + ioffg + jch * a_dim1],
kusano 7d535a
				     &ilda, &temp, &extra);
kusano 7d535a
			    icol = jch;
kusano 7d535a
/* L220: */
kusano 7d535a
			}
kusano 7d535a
/* L230: */
kusano 7d535a
		    }
kusano 7d535a
/* L240: */
kusano 7d535a
		}
kusano 7d535a
kusano 7d535a
/*              If we need upper triangle, copy from lower. No
kusano 7d535a
te that   
kusano 7d535a
                the order of copying is chosen to work for 'b'
kusano 7d535a
 -> 'q' */
kusano 7d535a
kusano 7d535a
		if (ipack != ipackg && ipack != 4) {
kusano 7d535a
		    for (jc = *n; jc >= 1; --jc) {
kusano 7d535a
			irow = ioffst - iskew * jc;
kusano 7d535a
/* Computing MAX */
kusano 7d535a
			i__2 = 1, i__4 = jc - uub;
kusano 7d535a
			i__1 = max(i__2,i__4);
kusano 7d535a
			for (jr = jc; jr >= i__1; --jr) {
kusano 7d535a
			    a[jr + irow + jc * a_dim1] = a[jc - iskew * jr + 
kusano 7d535a
				    ioffg + jr * a_dim1];
kusano 7d535a
/* L250: */
kusano 7d535a
			}
kusano 7d535a
/* L260: */
kusano 7d535a
		    }
kusano 7d535a
		    if (ipack == 6) {
kusano 7d535a
			i__1 = uub;
kusano 7d535a
			for (jc = 1; jc <= i__1; ++jc) {
kusano 7d535a
			    i__2 = uub + 1 - jc;
kusano 7d535a
			    for (jr = 1; jr <= i__2; ++jr) {
kusano 7d535a
				a[jr + jc * a_dim1] = 0.f;
kusano 7d535a
/* L270: */
kusano 7d535a
			    }
kusano 7d535a
/* L280: */
kusano 7d535a
			}
kusano 7d535a
		    }
kusano 7d535a
		    if (ipackg == 5) {
kusano 7d535a
			ipackg = ipack;
kusano 7d535a
		    } else {
kusano 7d535a
			ipackg = 0;
kusano 7d535a
		    }
kusano 7d535a
		}
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
    } else {
kusano 7d535a
kusano 7d535a
/*        4)      Generate Banded Matrix by first   
kusano 7d535a
                  Rotating by random Unitary matrices,   
kusano 7d535a
                  then reducing the bandwidth using Householder   
kusano 7d535a
                  transformations.   
kusano 7d535a
kusano 7d535a
                  Note: we should get here only if LDA .ge. N */
kusano 7d535a
kusano 7d535a
	if (isym == 1) {
kusano 7d535a
kusano 7d535a
/*           Non-symmetric -- A = U D V */
kusano 7d535a
kusano 7d535a
	    slagge_(&mr, &nc, &llb, &uub, &d[1], &a[a_offset], lda, &iseed[1],
kusano 7d535a
		     &work[1], &iinfo);
kusano 7d535a
	} else {
kusano 7d535a
kusano 7d535a
/*           Symmetric -- A = U D U' */
kusano 7d535a
kusano 7d535a
	    slagsy_(m, &llb, &d[1], &a[a_offset], lda, &iseed[1], &work[1], &
kusano 7d535a
		    iinfo);
kusano 7d535a
kusano 7d535a
	}
kusano 7d535a
	if (iinfo != 0) {
kusano 7d535a
	    *info = 3;
kusano 7d535a
	    return 0;
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     5)      Pack the matrix */
kusano 7d535a
kusano 7d535a
    if (ipack != ipackg) {
kusano 7d535a
	if (ipack == 1) {
kusano 7d535a
kusano 7d535a
/*           'U' -- Upper triangular, not packed */
kusano 7d535a
kusano 7d535a
	    i__1 = *m;
kusano 7d535a
	    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
		i__2 = *m;
kusano 7d535a
		for (i = j + 1; i <= i__2; ++i) {
kusano 7d535a
		    a[i + j * a_dim1] = 0.f;
kusano 7d535a
/* L290: */
kusano 7d535a
		}
kusano 7d535a
/* L300: */
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	} else if (ipack == 2) {
kusano 7d535a
kusano 7d535a
/*           'L' -- Lower triangular, not packed */
kusano 7d535a
kusano 7d535a
	    i__1 = *m;
kusano 7d535a
	    for (j = 2; j <= i__1; ++j) {
kusano 7d535a
		i__2 = j - 1;
kusano 7d535a
		for (i = 1; i <= i__2; ++i) {
kusano 7d535a
		    a[i + j * a_dim1] = 0.f;
kusano 7d535a
/* L310: */
kusano 7d535a
		}
kusano 7d535a
/* L320: */
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	} else if (ipack == 3) {
kusano 7d535a
kusano 7d535a
/*           'C' -- Upper triangle packed Columnwise. */
kusano 7d535a
kusano 7d535a
	    icol = 1;
kusano 7d535a
	    irow = 0;
kusano 7d535a
	    i__1 = *m;
kusano 7d535a
	    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
		i__2 = j;
kusano 7d535a
		for (i = 1; i <= i__2; ++i) {
kusano 7d535a
		    ++irow;
kusano 7d535a
		    if (irow > *lda) {
kusano 7d535a
			irow = 1;
kusano 7d535a
			++icol;
kusano 7d535a
		    }
kusano 7d535a
		    a[irow + icol * a_dim1] = a[i + j * a_dim1];
kusano 7d535a
/* L330: */
kusano 7d535a
		}
kusano 7d535a
/* L340: */
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	} else if (ipack == 4) {
kusano 7d535a
kusano 7d535a
/*           'R' -- Lower triangle packed Columnwise. */
kusano 7d535a
kusano 7d535a
	    icol = 1;
kusano 7d535a
	    irow = 0;
kusano 7d535a
	    i__1 = *m;
kusano 7d535a
	    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
		i__2 = *m;
kusano 7d535a
		for (i = j; i <= i__2; ++i) {
kusano 7d535a
		    ++irow;
kusano 7d535a
		    if (irow > *lda) {
kusano 7d535a
			irow = 1;
kusano 7d535a
			++icol;
kusano 7d535a
		    }
kusano 7d535a
		    a[irow + icol * a_dim1] = a[i + j * a_dim1];
kusano 7d535a
/* L350: */
kusano 7d535a
		}
kusano 7d535a
/* L360: */
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	} else if (ipack >= 5) {
kusano 7d535a
kusano 7d535a
/*           'B' -- The lower triangle is packed as a band matrix.
kusano 7d535a
   
kusano 7d535a
             'Q' -- The upper triangle is packed as a band matrix.
kusano 7d535a
   
kusano 7d535a
             'Z' -- The whole matrix is packed as a band matrix. 
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
	    if (ipack == 5) {
kusano 7d535a
		uub = 0;
kusano 7d535a
	    }
kusano 7d535a
	    if (ipack == 6) {
kusano 7d535a
		llb = 0;
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	    i__1 = uub;
kusano 7d535a
	    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
		i__2 = j + llb;
kusano 7d535a
		for (i = min(i__2,*m); i >= 1; --i) {
kusano 7d535a
		    a[i - j + uub + 1 + j * a_dim1] = a[i + j * a_dim1];
kusano 7d535a
/* L370: */
kusano 7d535a
		}
kusano 7d535a
/* L380: */
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = uub + 2; j <= i__1; ++j) {
kusano 7d535a
/* Computing MIN */
kusano 7d535a
		i__4 = j + llb;
kusano 7d535a
		i__2 = min(i__4,*m);
kusano 7d535a
		for (i = j - uub; i <= i__2; ++i) {
kusano 7d535a
		    a[i - j + uub + 1 + j * a_dim1] = a[i + j * a_dim1];
kusano 7d535a
/* L390: */
kusano 7d535a
		}
kusano 7d535a
/* L400: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        If packed, zero out extraneous elements.   
kusano 7d535a
kusano 7d535a
          Symmetric/Triangular Packed --   
kusano 7d535a
          zero out everything after A(IROW,ICOL) */
kusano 7d535a
kusano 7d535a
	if (ipack == 3 || ipack == 4) {
kusano 7d535a
	    i__1 = *m;
kusano 7d535a
	    for (jc = icol; jc <= i__1; ++jc) {
kusano 7d535a
		i__2 = *lda;
kusano 7d535a
		for (jr = irow + 1; jr <= i__2; ++jr) {
kusano 7d535a
		    a[jr + jc * a_dim1] = 0.f;
kusano 7d535a
/* L410: */
kusano 7d535a
		}
kusano 7d535a
		irow = 0;
kusano 7d535a
/* L420: */
kusano 7d535a
	    }
kusano 7d535a
kusano 7d535a
	} else if (ipack >= 5) {
kusano 7d535a
kusano 7d535a
/*           Packed Band --   
kusano 7d535a
                1st row is now in A( UUB+2-j, j), zero above it   
kusano 7d535a
                m-th row is now in A( M+UUB-j,j), zero below it   
kusano 7d535a
                last non-zero diagonal is now in A( UUB+LLB+1,j ),
kusano 7d535a
   
kusano 7d535a
                   zero below it, too. */
kusano 7d535a
kusano 7d535a
	    ir1 = uub + llb + 2;
kusano 7d535a
	    ir2 = uub + *m + 2;
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (jc = 1; jc <= i__1; ++jc) {
kusano 7d535a
		i__2 = uub + 1 - jc;
kusano 7d535a
		for (jr = 1; jr <= i__2; ++jr) {
kusano 7d535a
		    a[jr + jc * a_dim1] = 0.f;
kusano 7d535a
/* L430: */
kusano 7d535a
		}
kusano 7d535a
/* Computing MAX   
kusano 7d535a
   Computing MIN */
kusano 7d535a
		i__3 = ir1, i__5 = ir2 - jc;
kusano 7d535a
		i__2 = 1, i__4 = min(i__3,i__5);
kusano 7d535a
		i__6 = *lda;
kusano 7d535a
		for (jr = max(i__2,i__4); jr <= i__6; ++jr) {
kusano 7d535a
		    a[jr + jc * a_dim1] = 0.f;
kusano 7d535a
/* L440: */
kusano 7d535a
		}
kusano 7d535a
/* L450: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of SLATMS */
kusano 7d535a
kusano 7d535a
} /* slatms_ */
kusano 7d535a