|
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 |
|