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 doublecomplex c_b1 = {0.,0.};
kusano 7d535a
static doublecomplex c_b2 = {1.,0.};
kusano 7d535a
static integer c__1 = 1;
kusano 7d535a
static integer c__0 = 0;
kusano 7d535a
static integer c__5 = 5;
kusano 7d535a
kusano 7d535a
/* Subroutine */ int zlatme_(integer *n, char *dist, integer *iseed, 
kusano 7d535a
	doublecomplex *d, integer *mode, doublereal *cond, doublecomplex *
kusano 7d535a
	dmax__, char *ei, char *rsign, char *upper, char *sim, doublereal *ds,
kusano 7d535a
	 integer *modes, doublereal *conds, integer *kl, integer *ku, 
kusano 7d535a
	doublereal *anorm, doublecomplex *a, integer *lda, doublecomplex *
kusano 7d535a
	work, integer *info)
kusano 7d535a
{
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer a_dim1, a_offset, i__1, i__2;
kusano 7d535a
    doublereal d__1, d__2;
kusano 7d535a
    doublecomplex z__1, z__2;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    double z_abs(doublecomplex *);
kusano 7d535a
    void d_cnjg(doublecomplex *, doublecomplex *);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static logical bads;
kusano 7d535a
    static integer isim;
kusano 7d535a
    static doublereal temp;
kusano 7d535a
    static integer i, j;
kusano 7d535a
    static doublecomplex alpha;
kusano 7d535a
    extern logical lsame_(char *, char *);
kusano 7d535a
    static integer iinfo;
kusano 7d535a
    static doublereal tempa[1];
kusano 7d535a
    static integer icols;
kusano 7d535a
    extern /* Subroutine */ int zgerc_(integer *, integer *, doublecomplex *, 
kusano 7d535a
	    doublecomplex *, integer *, doublecomplex *, integer *, 
kusano 7d535a
	    doublecomplex *, integer *);
kusano 7d535a
    static integer idist;
kusano 7d535a
    extern /* Subroutine */ int zscal_(integer *, doublecomplex *, 
kusano 7d535a
	    doublecomplex *, integer *), zgemv_(char *, integer *, integer *, 
kusano 7d535a
	    doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
kusano 7d535a
	    integer *, doublecomplex *, doublecomplex *, integer *);
kusano 7d535a
    static integer irows;
kusano 7d535a
    extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *, 
kusano 7d535a
	    doublecomplex *, integer *), dlatm1_(integer *, doublereal *, 
kusano 7d535a
	    integer *, integer *, integer *, doublereal *, integer *, integer 
kusano 7d535a
	    *), zlatm1_(integer *, doublereal *, integer *, integer *, 
kusano 7d535a
	    integer *, doublecomplex *, integer *, integer *);
kusano 7d535a
    static integer ic, jc, ir;
kusano 7d535a
    static doublereal ralpha;
kusano 7d535a
    extern /* Subroutine */ int xerbla_(char *, integer *);
kusano 7d535a
    extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, 
kusano 7d535a
	    integer *, doublereal *);
kusano 7d535a
    extern /* Subroutine */ int zdscal_(integer *, doublereal *, 
kusano 7d535a
	    doublecomplex *, integer *), zlarge_(integer *, doublecomplex *, 
kusano 7d535a
	    integer *, integer *, doublecomplex *, integer *), zlarfg_(
kusano 7d535a
	    integer *, doublecomplex *, doublecomplex *, integer *, 
kusano 7d535a
	    doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *);
kusano 7d535a
    extern /* Double Complex */ void zlarnd_(doublecomplex *, integer *, 
kusano 7d535a
	    integer *);
kusano 7d535a
    static integer irsign;
kusano 7d535a
    extern /* Subroutine */ int zlaset_(char *, integer *, integer *, 
kusano 7d535a
	    doublecomplex *, doublecomplex *, doublecomplex *, integer *);
kusano 7d535a
    static integer iupper;
kusano 7d535a
    extern /* Subroutine */ int zlarnv_(integer *, integer *, integer *, 
kusano 7d535a
	    doublecomplex *);
kusano 7d535a
    static doublecomplex xnorms;
kusano 7d535a
    static integer jcr;
kusano 7d535a
    static doublecomplex tau;
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
       ZLATME generates random non-symmetric square matrices with   
kusano 7d535a
       specified eigenvalues for testing LAPACK programs.   
kusano 7d535a
kusano 7d535a
       ZLATME operates by applying the following sequence of   
kusano 7d535a
       operations:   
kusano 7d535a
kusano 7d535a
       1. Set the diagonal to D, where D may be input or   
kusano 7d535a
            computed according to MODE, COND, DMAX, and RSIGN   
kusano 7d535a
            as described below.   
kusano 7d535a
kusano 7d535a
       2. If UPPER='T', the upper triangle of A is set to random values   
kusano 7d535a
            out of distribution DIST.   
kusano 7d535a
kusano 7d535a
       3. If SIM='T', A is multiplied on the left by a random matrix   
kusano 7d535a
            X, whose singular values are specified by DS, MODES, and   
kusano 7d535a
            CONDS, and on the right by X inverse.   
kusano 7d535a
kusano 7d535a
       4. If KL < N-1, the lower bandwidth is reduced to KL using   
kusano 7d535a
            Householder transformations.  If KU < N-1, the upper   
kusano 7d535a
            bandwidth is reduced to KU.   
kusano 7d535a
kusano 7d535a
       5. If ANORM is not negative, the matrix is scaled to have   
kusano 7d535a
            maximum-element-norm ANORM.   
kusano 7d535a
kusano 7d535a
       (Note: since the matrix cannot be reduced beyond Hessenberg form, 
kusano 7d535a
  
kusano 7d535a
        no packing options are available.)   
kusano 7d535a
kusano 7d535a
    Arguments   
kusano 7d535a
    =========   
kusano 7d535a
kusano 7d535a
    N      - INTEGER   
kusano 7d535a
             The number of columns (or rows) 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, and on the   
kusano 7d535a
             upper triangle (see UPPER).   
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
             'D' => uniform on the complex disc |z| < 1.   
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 ZLATME   
kusano 7d535a
             to continue the same random number sequence.   
kusano 7d535a
             Changed on exit.   
kusano 7d535a
kusano 7d535a
    D      - COMPLEX*16 array, dimension ( N )   
kusano 7d535a
             This array is used to specify the eigenvalues of A.  If   
kusano 7d535a
             MODE=0, then D is assumed to contain the eigenvalues   
kusano 7d535a
             otherwise they will be computed according to MODE, COND,   
kusano 7d535a
             DMAX, and RSIGN 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 eigenvalues are to   
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 between 1 and 4, D has entries ranging   
kusano 7d535a
                from 1 to 1/COND, if between -1 and -4, D has entries   
kusano 7d535a
                ranging from 1/COND to 1,   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    COND   - DOUBLE PRECISION   
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   - COMPLEX*16   
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))).  Note that DMAX need not be   
kusano 7d535a
             positive or real: if DMAX is negative or complex (or zero), 
kusano 7d535a
  
kusano 7d535a
             D will be scaled by a negative or complex number (or zero). 
kusano 7d535a
  
kusano 7d535a
             If RSIGN='F' then the largest (absolute) eigenvalue will be 
kusano 7d535a
  
kusano 7d535a
             equal to DMAX.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    EI     - CHARACTER*1 (ignored)   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    RSIGN  - CHARACTER*1   
kusano 7d535a
             If MODE is not 0, 6, or -6, and RSIGN='T', then the   
kusano 7d535a
             elements of D, as computed according to MODE and COND, will 
kusano 7d535a
  
kusano 7d535a
             be multiplied by a random complex number from the unit   
kusano 7d535a
             circle |z| = 1.  If RSIGN='F', they will not be.  RSIGN may 
kusano 7d535a
  
kusano 7d535a
             only have the values 'T' or 'F'.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    UPPER  - CHARACTER*1   
kusano 7d535a
             If UPPER='T', then the elements of A above the diagonal   
kusano 7d535a
             will be set to random numbers out of DIST.  If UPPER='F',   
kusano 7d535a
             they will not.  UPPER may only have the values 'T' or 'F'.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    SIM    - CHARACTER*1   
kusano 7d535a
             If SIM='T', then A will be operated on by a "similarity   
kusano 7d535a
             transform", i.e., multiplied on the left by a matrix X and   
kusano 7d535a
             on the right by X inverse.  X = U S V, where U and V are   
kusano 7d535a
             random unitary matrices and S is a (diagonal) matrix of   
kusano 7d535a
             singular values specified by DS, MODES, and CONDS.  If   
kusano 7d535a
             SIM='F', then A will not be transformed.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    DS     - DOUBLE PRECISION array, dimension ( N )   
kusano 7d535a
             This array is used to specify the singular values of X,   
kusano 7d535a
             in the same way that D specifies the eigenvalues of A.   
kusano 7d535a
             If MODE=0, the DS contains the singular values, which   
kusano 7d535a
             may not be zero.   
kusano 7d535a
             Modified if MODE is nonzero.   
kusano 7d535a
kusano 7d535a
    MODES  - INTEGER   
kusano 7d535a
    CONDS  - DOUBLE PRECISION   
kusano 7d535a
             Similar to MODE and COND, but for specifying the diagonal   
kusano 7d535a
             of S.  MODES=-6 and +6 are not allowed (since they would   
kusano 7d535a
             result in randomly ill-conditioned eigenvalues.)   
kusano 7d535a
kusano 7d535a
    KL     - INTEGER   
kusano 7d535a
             This specifies the lower bandwidth of the  matrix.  KL=1   
kusano 7d535a
             specifies upper Hessenberg form.  If KL is at least N-1,   
kusano 7d535a
             then A will have full lower bandwidth.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    KU     - INTEGER   
kusano 7d535a
             This specifies the upper bandwidth of the  matrix.  KU=1   
kusano 7d535a
             specifies lower Hessenberg form.  If KU is at least N-1,   
kusano 7d535a
             then A will have full upper bandwidth; if KU and KL   
kusano 7d535a
             are both at least N-1, then A will be dense.  Only one of   
kusano 7d535a
             KU and KL may be less than N-1.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    ANORM  - DOUBLE PRECISION   
kusano 7d535a
             If ANORM is not negative, then A will be scaled by a non-   
kusano 7d535a
             negative real number to make the maximum-element-norm of A   
kusano 7d535a
             to be ANORM.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    A      - COMPLEX*16 array, dimension ( LDA, N )   
kusano 7d535a
             On exit A is the desired test matrix.   
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.  LDA must be at least M.   
kusano 7d535a
             Not modified.   
kusano 7d535a
kusano 7d535a
    WORK   - COMPLEX*16 array, dimension ( 3*N )   
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 => N negative   
kusano 7d535a
              -2 => DIST illegal string   
kusano 7d535a
              -5 => MODE not in range -6 to 6   
kusano 7d535a
              -6 => COND less than 1.0, and MODE neither -6, 0 nor 6   
kusano 7d535a
              -9 => RSIGN is not 'T' or 'F'   
kusano 7d535a
             -10 => UPPER is not 'T' or 'F'   
kusano 7d535a
             -11 => SIM   is not 'T' or 'F'   
kusano 7d535a
             -12 => MODES=0 and DS has a zero singular value.   
kusano 7d535a
             -13 => MODES is not in the range -5 to 5.   
kusano 7d535a
             -14 => MODES is nonzero and CONDS is less than 1.   
kusano 7d535a
             -15 => KL is less than 1.   
kusano 7d535a
             -16 => KU is less than 1, or KL and KU are both less than   
kusano 7d535a
                    N-1.   
kusano 7d535a
             -19 => LDA is less than M.   
kusano 7d535a
              1  => Error return from ZLATM1 (computing D)   
kusano 7d535a
              2  => Cannot scale to DMAX (max. eigenvalue is 0)   
kusano 7d535a
              3  => Error return from DLATM1 (computing DS)   
kusano 7d535a
              4  => Error return from ZLARGE   
kusano 7d535a
              5  => Zero singular value from DLATM1.   
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
    --ds;
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 (*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 if (lsame_(dist, "D")) {
kusano 7d535a
	idist = 4;
kusano 7d535a
    } else {
kusano 7d535a
	idist = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Decode RSIGN */
kusano 7d535a
kusano 7d535a
    if (lsame_(rsign, "T")) {
kusano 7d535a
	irsign = 1;
kusano 7d535a
    } else if (lsame_(rsign, "F")) {
kusano 7d535a
	irsign = 0;
kusano 7d535a
    } else {
kusano 7d535a
	irsign = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Decode UPPER */
kusano 7d535a
kusano 7d535a
    if (lsame_(upper, "T")) {
kusano 7d535a
	iupper = 1;
kusano 7d535a
    } else if (lsame_(upper, "F")) {
kusano 7d535a
	iupper = 0;
kusano 7d535a
    } else {
kusano 7d535a
	iupper = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Decode SIM */
kusano 7d535a
kusano 7d535a
    if (lsame_(sim, "T")) {
kusano 7d535a
	isim = 1;
kusano 7d535a
    } else if (lsame_(sim, "F")) {
kusano 7d535a
	isim = 0;
kusano 7d535a
    } else {
kusano 7d535a
	isim = -1;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Check DS, if MODES=0 and ISIM=1 */
kusano 7d535a
kusano 7d535a
    bads = FALSE_;
kusano 7d535a
    if (*modes == 0 && isim == 1) {
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (j = 1; j <= i__1; ++j) {
kusano 7d535a
	    if (ds[j] == 0.) {
kusano 7d535a
		bads = TRUE_;
kusano 7d535a
	    }
kusano 7d535a
/* L10: */
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Set INFO if an error */
kusano 7d535a
kusano 7d535a
    if (*n < 0) {
kusano 7d535a
	*info = -1;
kusano 7d535a
    } else if (idist == -1) {
kusano 7d535a
	*info = -2;
kusano 7d535a
    } else if (abs(*mode) > 6) {
kusano 7d535a
	*info = -5;
kusano 7d535a
    } else if (*mode != 0 && abs(*mode) != 6 && *cond < 1.) {
kusano 7d535a
	*info = -6;
kusano 7d535a
    } else if (irsign == -1) {
kusano 7d535a
	*info = -9;
kusano 7d535a
    } else if (iupper == -1) {
kusano 7d535a
	*info = -10;
kusano 7d535a
    } else if (isim == -1) {
kusano 7d535a
	*info = -11;
kusano 7d535a
    } else if (bads) {
kusano 7d535a
	*info = -12;
kusano 7d535a
    } else if (isim == 1 && abs(*modes) > 5) {
kusano 7d535a
	*info = -13;
kusano 7d535a
    } else if (isim == 1 && *modes != 0 && *conds < 1.) {
kusano 7d535a
	*info = -14;
kusano 7d535a
    } else if (*kl < 1) {
kusano 7d535a
	*info = -15;
kusano 7d535a
    } else if (*ku < 1 || *ku < *n - 1 && *kl < *n - 1) {
kusano 7d535a
	*info = -16;
kusano 7d535a
    } else if (*lda < max(1,*n)) {
kusano 7d535a
	*info = -19;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (*info != 0) {
kusano 7d535a
	i__1 = -(*info);
kusano 7d535a
	xerbla_("ZLATME", &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
/* L20: */
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    if (iseed[4] % 2 != 1) {
kusano 7d535a
	++iseed[4];
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     2)      Set up diagonal of A   
kusano 7d535a
kusano 7d535a
               Compute D according to COND and MODE */
kusano 7d535a
kusano 7d535a
    zlatm1_(mode, cond, &irsign, &idist, &iseed[1], &d[1], n, &iinfo);
kusano 7d535a
    if (iinfo != 0) {
kusano 7d535a
	*info = 1;
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
    if (*mode != 0 && abs(*mode) != 6) {
kusano 7d535a
kusano 7d535a
/*        Scale by DMAX */
kusano 7d535a
kusano 7d535a
	temp = z_abs(&d[1]);
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (i = 2; i <= i__1; ++i) {
kusano 7d535a
/* Computing MAX */
kusano 7d535a
	    d__1 = temp, d__2 = z_abs(&d[i]);
kusano 7d535a
	    temp = max(d__1,d__2);
kusano 7d535a
/* L30: */
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	if (temp > 0.) {
kusano 7d535a
	    z__1.r = dmax__->r / temp, z__1.i = dmax__->i / temp;
kusano 7d535a
	    alpha.r = z__1.r, alpha.i = z__1.i;
kusano 7d535a
	} else {
kusano 7d535a
	    *info = 2;
kusano 7d535a
	    return 0;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
	zscal_(n, &alpha, &d[1], &c__1);
kusano 7d535a
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    zlaset_("Full", n, n, &c_b1, &c_b1, &a[a_offset], lda);
kusano 7d535a
    i__1 = *lda + 1;
kusano 7d535a
    zcopy_(n, &d[1], &c__1, &a[a_offset], &i__1);
kusano 7d535a
kusano 7d535a
/*     3)      If UPPER='T', set upper triangle of A to random numbers. */
kusano 7d535a
kusano 7d535a
    if (iupper != 0) {
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (jc = 2; jc <= i__1; ++jc) {
kusano 7d535a
	    i__2 = jc - 1;
kusano 7d535a
	    zlarnv_(&idist, &iseed[1], &i__2, &a[jc * a_dim1 + 1]);
kusano 7d535a
/* L40: */
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     4)      If SIM='T', apply similarity transformation.   
kusano 7d535a
kusano 7d535a
                                  -1   
kusano 7d535a
               Transform is  X A X  , where X = U S V, thus   
kusano 7d535a
kusano 7d535a
               it is  U S V A V' (1/S) U' */
kusano 7d535a
kusano 7d535a
    if (isim != 0) {
kusano 7d535a
kusano 7d535a
/*        Compute S (singular values of the eigenvector matrix)   
kusano 7d535a
          according to CONDS and MODES */
kusano 7d535a
kusano 7d535a
	dlatm1_(modes, conds, &c__0, &c__0, &iseed[1], &ds[1], n, &iinfo);
kusano 7d535a
	if (iinfo != 0) {
kusano 7d535a
	    *info = 3;
kusano 7d535a
	    return 0;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Multiply by V and V' */
kusano 7d535a
kusano 7d535a
	zlarge_(n, &a[a_offset], lda, &iseed[1], &work[1], &iinfo);
kusano 7d535a
	if (iinfo != 0) {
kusano 7d535a
	    *info = 4;
kusano 7d535a
	    return 0;
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Multiply by S and (1/S) */
kusano 7d535a
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (j = 1; j <= i__1; ++j) {
kusano 7d535a
	    zdscal_(n, &ds[j], &a[j + a_dim1], lda);
kusano 7d535a
	    if (ds[j] != 0.) {
kusano 7d535a
		d__1 = 1. / ds[j];
kusano 7d535a
		zdscal_(n, &d__1, &a[j * a_dim1 + 1], &c__1);
kusano 7d535a
	    } else {
kusano 7d535a
		*info = 5;
kusano 7d535a
		return 0;
kusano 7d535a
	    }
kusano 7d535a
/* L50: */
kusano 7d535a
	}
kusano 7d535a
kusano 7d535a
/*        Multiply by U and U' */
kusano 7d535a
kusano 7d535a
	zlarge_(n, &a[a_offset], lda, &iseed[1], &work[1], &iinfo);
kusano 7d535a
	if (iinfo != 0) {
kusano 7d535a
	    *info = 4;
kusano 7d535a
	    return 0;
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     5)      Reduce the bandwidth. */
kusano 7d535a
kusano 7d535a
    if (*kl < *n - 1) {
kusano 7d535a
kusano 7d535a
/*        Reduce bandwidth -- kill column */
kusano 7d535a
kusano 7d535a
	i__1 = *n - 1;
kusano 7d535a
	for (jcr = *kl + 1; jcr <= i__1; ++jcr) {
kusano 7d535a
	    ic = jcr - *kl;
kusano 7d535a
	    irows = *n + 1 - jcr;
kusano 7d535a
	    icols = *n + *kl - jcr;
kusano 7d535a
kusano 7d535a
	    zcopy_(&irows, &a[jcr + ic * a_dim1], &c__1, &work[1], &c__1);
kusano 7d535a
	    xnorms.r = work[1].r, xnorms.i = work[1].i;
kusano 7d535a
	    zlarfg_(&irows, &xnorms, &work[2], &c__1, &tau);
kusano 7d535a
	    d_cnjg(&z__1, &tau);
kusano 7d535a
	    tau.r = z__1.r, tau.i = z__1.i;
kusano 7d535a
	    work[1].r = 1., work[1].i = 0.;
kusano 7d535a
	    zlarnd_(&z__1, &c__5, &iseed[1]);
kusano 7d535a
	    alpha.r = z__1.r, alpha.i = z__1.i;
kusano 7d535a
kusano 7d535a
	    zgemv_("C", &irows, &icols, &c_b2, &a[jcr + (ic + 1) * a_dim1], 
kusano 7d535a
		    lda, &work[1], &c__1, &c_b1, &work[irows + 1], &c__1);
kusano 7d535a
	    z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
	    zgerc_(&irows, &icols, &z__1, &work[1], &c__1, &work[irows + 1], &
kusano 7d535a
		    c__1, &a[jcr + (ic + 1) * a_dim1], lda);
kusano 7d535a
kusano 7d535a
	    zgemv_("N", n, &irows, &c_b2, &a[jcr * a_dim1 + 1], lda, &work[1],
kusano 7d535a
		     &c__1, &c_b1, &work[irows + 1], &c__1);
kusano 7d535a
	    d_cnjg(&z__2, &tau);
kusano 7d535a
	    z__1.r = -z__2.r, z__1.i = -z__2.i;
kusano 7d535a
	    zgerc_(n, &irows, &z__1, &work[irows + 1], &c__1, &work[1], &c__1,
kusano 7d535a
		     &a[jcr * a_dim1 + 1], lda);
kusano 7d535a
kusano 7d535a
	    i__2 = jcr + ic * a_dim1;
kusano 7d535a
	    a[i__2].r = xnorms.r, a[i__2].i = xnorms.i;
kusano 7d535a
	    i__2 = irows - 1;
kusano 7d535a
	    zlaset_("Full", &i__2, &c__1, &c_b1, &c_b1, &a[jcr + 1 + ic * 
kusano 7d535a
		    a_dim1], lda);
kusano 7d535a
kusano 7d535a
	    i__2 = icols + 1;
kusano 7d535a
	    zscal_(&i__2, &alpha, &a[jcr + ic * a_dim1], lda);
kusano 7d535a
	    d_cnjg(&z__1, &alpha);
kusano 7d535a
	    zscal_(n, &z__1, &a[jcr * a_dim1 + 1], &c__1);
kusano 7d535a
/* L60: */
kusano 7d535a
	}
kusano 7d535a
    } else if (*ku < *n - 1) {
kusano 7d535a
kusano 7d535a
/*        Reduce upper bandwidth -- kill a row at a time. */
kusano 7d535a
kusano 7d535a
	i__1 = *n - 1;
kusano 7d535a
	for (jcr = *ku + 1; jcr <= i__1; ++jcr) {
kusano 7d535a
	    ir = jcr - *ku;
kusano 7d535a
	    irows = *n + *ku - jcr;
kusano 7d535a
	    icols = *n + 1 - jcr;
kusano 7d535a
kusano 7d535a
	    zcopy_(&icols, &a[ir + jcr * a_dim1], lda, &work[1], &c__1);
kusano 7d535a
	    xnorms.r = work[1].r, xnorms.i = work[1].i;
kusano 7d535a
	    zlarfg_(&icols, &xnorms, &work[2], &c__1, &tau);
kusano 7d535a
	    d_cnjg(&z__1, &tau);
kusano 7d535a
	    tau.r = z__1.r, tau.i = z__1.i;
kusano 7d535a
	    work[1].r = 1., work[1].i = 0.;
kusano 7d535a
	    i__2 = icols - 1;
kusano 7d535a
	    zlacgv_(&i__2, &work[2], &c__1);
kusano 7d535a
	    zlarnd_(&z__1, &c__5, &iseed[1]);
kusano 7d535a
	    alpha.r = z__1.r, alpha.i = z__1.i;
kusano 7d535a
kusano 7d535a
	    zgemv_("N", &irows, &icols, &c_b2, &a[ir + 1 + jcr * a_dim1], lda,
kusano 7d535a
		     &work[1], &c__1, &c_b1, &work[icols + 1], &c__1);
kusano 7d535a
	    z__1.r = -tau.r, z__1.i = -tau.i;
kusano 7d535a
	    zgerc_(&irows, &icols, &z__1, &work[icols + 1], &c__1, &work[1], &
kusano 7d535a
		    c__1, &a[ir + 1 + jcr * a_dim1], lda);
kusano 7d535a
kusano 7d535a
	    zgemv_("C", &icols, n, &c_b2, &a[jcr + a_dim1], lda, &work[1], &
kusano 7d535a
		    c__1, &c_b1, &work[icols + 1], &c__1);
kusano 7d535a
	    d_cnjg(&z__2, &tau);
kusano 7d535a
	    z__1.r = -z__2.r, z__1.i = -z__2.i;
kusano 7d535a
	    zgerc_(&icols, n, &z__1, &work[1], &c__1, &work[icols + 1], &c__1,
kusano 7d535a
		     &a[jcr + a_dim1], lda);
kusano 7d535a
kusano 7d535a
	    i__2 = ir + jcr * a_dim1;
kusano 7d535a
	    a[i__2].r = xnorms.r, a[i__2].i = xnorms.i;
kusano 7d535a
	    i__2 = icols - 1;
kusano 7d535a
	    zlaset_("Full", &c__1, &i__2, &c_b1, &c_b1, &a[ir + (jcr + 1) * 
kusano 7d535a
		    a_dim1], lda);
kusano 7d535a
kusano 7d535a
	    i__2 = irows + 1;
kusano 7d535a
	    zscal_(&i__2, &alpha, &a[ir + jcr * a_dim1], &c__1);
kusano 7d535a
	    d_cnjg(&z__1, &alpha);
kusano 7d535a
	    zscal_(n, &z__1, &a[jcr + a_dim1], lda);
kusano 7d535a
/* L70: */
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Scale the matrix to have norm ANORM */
kusano 7d535a
kusano 7d535a
    if (*anorm >= 0.) {
kusano 7d535a
	temp = zlange_("M", n, n, &a[a_offset], lda, tempa);
kusano 7d535a
	if (temp > 0.) {
kusano 7d535a
	    ralpha = *anorm / temp;
kusano 7d535a
	    i__1 = *n;
kusano 7d535a
	    for (j = 1; j <= i__1; ++j) {
kusano 7d535a
		zdscal_(n, &ralpha, &a[j * a_dim1 + 1], &c__1);
kusano 7d535a
/* L80: */
kusano 7d535a
	    }
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of ZLATME */
kusano 7d535a
kusano 7d535a
} /* zlatme_ */
kusano 7d535a