|
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 |
/* Double Complex */ VOID zlatm2_(doublecomplex * ret_val, integer *m,
|
|
kusano |
7d535a |
integer *n, integer *i, integer *j, integer *kl, integer *ku, integer
|
|
kusano |
7d535a |
*idist, integer *iseed, doublecomplex *d, integer *igrade,
|
|
kusano |
7d535a |
doublecomplex *dl, doublecomplex *dr, integer *ipvtng, integer *iwork,
|
|
kusano |
7d535a |
doublereal *sparse)
|
|
kusano |
7d535a |
{
|
|
kusano |
7d535a |
/* System generated locals */
|
|
kusano |
7d535a |
integer i__1, i__2;
|
|
kusano |
7d535a |
doublecomplex z__1, z__2, z__3;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Builtin functions */
|
|
kusano |
7d535a |
void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
|
|
kusano |
7d535a |
doublecomplex *, doublecomplex *);
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Local variables */
|
|
kusano |
7d535a |
static integer isub, jsub;
|
|
kusano |
7d535a |
static doublecomplex ctemp;
|
|
kusano |
7d535a |
extern doublereal dlaran_(integer *);
|
|
kusano |
7d535a |
extern /* Double Complex */ VOID zlarnd_(doublecomplex *, integer *,
|
|
kusano |
7d535a |
integer *);
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* -- LAPACK auxiliary 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 |
February 29, 1992
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Purpose
|
|
kusano |
7d535a |
=======
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
ZLATM2 returns the (I,J) entry of a random matrix of dimension
|
|
kusano |
7d535a |
(M, N) described by the other paramters. It is called by the
|
|
kusano |
7d535a |
ZLATMR routine in order to build random test matrices. No error
|
|
kusano |
7d535a |
checking on parameters is done, because this routine is called in
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
a tight loop by ZLATMR which has already checked the parameters.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Use of ZLATM2 differs from CLATM3 in the order in which the random
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
number generator is called to fill in random matrix entries.
|
|
kusano |
7d535a |
With ZLATM2, the generator is called to fill in the pivoted matrix
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
columnwise. With ZLATM3, the generator is called to fill in the
|
|
kusano |
7d535a |
matrix columnwise, after which it is pivoted. Thus, ZLATM3 can
|
|
kusano |
7d535a |
be used to construct random matrices which differ only in their
|
|
kusano |
7d535a |
order of rows and/or columns. ZLATM2 is used to construct band
|
|
kusano |
7d535a |
matrices while avoiding calling the random number generator for
|
|
kusano |
7d535a |
entries outside the band (and therefore generating random numbers
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
The matrix whose (I,J) entry is returned is constructed as
|
|
kusano |
7d535a |
follows (this routine only computes one entry):
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
If I is outside (1..M) or J is outside (1..N), return zero
|
|
kusano |
7d535a |
(this is convenient for generating matrices in band format).
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Generate a matrix A with random entries of distribution IDIST.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Set the diagonal to D.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Grade the matrix, if desired, from the left (by DL) and/or
|
|
kusano |
7d535a |
from the right (by DR or DL) as specified by IGRADE.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Permute, if desired, the rows and/or columns as specified by
|
|
kusano |
7d535a |
IPVTNG and IWORK.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Band the matrix to have lower bandwidth KL and upper
|
|
kusano |
7d535a |
bandwidth KU.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Set random entries to zero as specified by SPARSE.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Arguments
|
|
kusano |
7d535a |
=========
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
M - INTEGER
|
|
kusano |
7d535a |
Number of rows of matrix. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
N - INTEGER
|
|
kusano |
7d535a |
Number of columns of matrix. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
I - INTEGER
|
|
kusano |
7d535a |
Row of entry to be returned. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
J - INTEGER
|
|
kusano |
7d535a |
Column of entry to be returned. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
KL - INTEGER
|
|
kusano |
7d535a |
Lower bandwidth. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
KU - INTEGER
|
|
kusano |
7d535a |
Upper bandwidth. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
IDIST - INTEGER
|
|
kusano |
7d535a |
On entry, IDIST specifies the type of distribution to be
|
|
kusano |
7d535a |
used to generate a random matrix .
|
|
kusano |
7d535a |
1 => real and imaginary parts each UNIFORM( 0, 1 )
|
|
kusano |
7d535a |
2 => real and imaginary parts each UNIFORM( -1, 1 )
|
|
kusano |
7d535a |
3 => real and imaginary parts each NORMAL( 0, 1 )
|
|
kusano |
7d535a |
4 => complex number uniform in DISK( 0 , 1 )
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
ISEED - INTEGER array of dimension ( 4 )
|
|
kusano |
7d535a |
Seed for random number generator.
|
|
kusano |
7d535a |
Changed on exit.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
D - COMPLEX*16 array of dimension ( MIN( I , J ) )
|
|
kusano |
7d535a |
Diagonal entries of matrix. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
IGRADE - INTEGER
|
|
kusano |
7d535a |
Specifies grading of matrix as follows:
|
|
kusano |
7d535a |
0 => no grading
|
|
kusano |
7d535a |
1 => matrix premultiplied by diag( DL )
|
|
kusano |
7d535a |
2 => matrix postmultiplied by diag( DR )
|
|
kusano |
7d535a |
3 => matrix premultiplied by diag( DL ) and
|
|
kusano |
7d535a |
postmultiplied by diag( DR )
|
|
kusano |
7d535a |
4 => matrix premultiplied by diag( DL ) and
|
|
kusano |
7d535a |
postmultiplied by inv( diag( DL ) )
|
|
kusano |
7d535a |
5 => matrix premultiplied by diag( DL ) and
|
|
kusano |
7d535a |
postmultiplied by diag( CONJG(DL) )
|
|
kusano |
7d535a |
6 => matrix premultiplied by diag( DL ) and
|
|
kusano |
7d535a |
postmultiplied by diag( DL )
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
DL - COMPLEX*16 array ( I or J, as appropriate )
|
|
kusano |
7d535a |
Left scale factors for grading matrix. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
DR - COMPLEX*16 array ( I or J, as appropriate )
|
|
kusano |
7d535a |
Right scale factors for grading matrix. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
IPVTNG - INTEGER
|
|
kusano |
7d535a |
On entry specifies pivoting permutations as follows:
|
|
kusano |
7d535a |
0 => none.
|
|
kusano |
7d535a |
1 => row pivoting.
|
|
kusano |
7d535a |
2 => column pivoting.
|
|
kusano |
7d535a |
3 => full pivoting, i.e., on both sides.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
IWORK - INTEGER array ( I or J, as appropriate )
|
|
kusano |
7d535a |
This array specifies the permutation used. The
|
|
kusano |
7d535a |
row (or column) in position K was originally in
|
|
kusano |
7d535a |
position IWORK( K ).
|
|
kusano |
7d535a |
This differs from IWORK for ZLATM3. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
SPARSE - DOUBLE PRECISION between 0. and 1.
|
|
kusano |
7d535a |
On entry specifies the sparsity of the matrix
|
|
kusano |
7d535a |
if sparse matix is to be generated.
|
|
kusano |
7d535a |
SPARSE should lie between 0 and 1.
|
|
kusano |
7d535a |
A uniform ( 0, 1 ) random number x is generated and
|
|
kusano |
7d535a |
compared to SPARSE; if x is larger the matrix entry
|
|
kusano |
7d535a |
is unchanged and if x is smaller the entry is set
|
|
kusano |
7d535a |
to zero. Thus on the average a fraction SPARSE of the
|
|
kusano |
7d535a |
entries will be set to zero.
|
|
kusano |
7d535a |
Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
=====================================================================
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
-----------------------------------------------------------------------
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Check for I and J in range
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Parameter adjustments */
|
|
kusano |
7d535a |
--iwork;
|
|
kusano |
7d535a |
--dr;
|
|
kusano |
7d535a |
--dl;
|
|
kusano |
7d535a |
--d;
|
|
kusano |
7d535a |
--iseed;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Function Body */
|
|
kusano |
7d535a |
if (*i < 1 || *i > *m || *j < 1 || *j > *n) {
|
|
kusano |
7d535a |
ret_val->r = 0., ret_val->i = 0.;
|
|
kusano |
7d535a |
return ;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Check for banding */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*j > *i + *ku || *j < *i - *kl) {
|
|
kusano |
7d535a |
ret_val->r = 0., ret_val->i = 0.;
|
|
kusano |
7d535a |
return ;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Check for sparsity */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*sparse > 0.) {
|
|
kusano |
7d535a |
if (dlaran_(&iseed[1]) < *sparse) {
|
|
kusano |
7d535a |
ret_val->r = 0., ret_val->i = 0.;
|
|
kusano |
7d535a |
return ;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Compute subscripts depending on IPVTNG */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*ipvtng == 0) {
|
|
kusano |
7d535a |
isub = *i;
|
|
kusano |
7d535a |
jsub = *j;
|
|
kusano |
7d535a |
} else if (*ipvtng == 1) {
|
|
kusano |
7d535a |
isub = iwork[*i];
|
|
kusano |
7d535a |
jsub = *j;
|
|
kusano |
7d535a |
} else if (*ipvtng == 2) {
|
|
kusano |
7d535a |
isub = *i;
|
|
kusano |
7d535a |
jsub = iwork[*j];
|
|
kusano |
7d535a |
} else if (*ipvtng == 3) {
|
|
kusano |
7d535a |
isub = iwork[*i];
|
|
kusano |
7d535a |
jsub = iwork[*j];
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Compute entry and grade it according to IGRADE */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (isub == jsub) {
|
|
kusano |
7d535a |
i__1 = isub;
|
|
kusano |
7d535a |
ctemp.r = d[i__1].r, ctemp.i = d[i__1].i;
|
|
kusano |
7d535a |
} else {
|
|
kusano |
7d535a |
zlarnd_(&z__1, idist, &iseed[1]);
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
if (*igrade == 1) {
|
|
kusano |
7d535a |
i__1 = isub;
|
|
kusano |
7d535a |
z__1.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__1.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 2) {
|
|
kusano |
7d535a |
i__1 = jsub;
|
|
kusano |
7d535a |
z__1.r = ctemp.r * dr[i__1].r - ctemp.i * dr[i__1].i, z__1.i =
|
|
kusano |
7d535a |
ctemp.r * dr[i__1].i + ctemp.i * dr[i__1].r;
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 3) {
|
|
kusano |
7d535a |
i__1 = isub;
|
|
kusano |
7d535a |
z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
i__2 = jsub;
|
|
kusano |
7d535a |
z__1.r = z__2.r * dr[i__2].r - z__2.i * dr[i__2].i, z__1.i = z__2.r *
|
|
kusano |
7d535a |
dr[i__2].i + z__2.i * dr[i__2].r;
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 4 && isub != jsub) {
|
|
kusano |
7d535a |
i__1 = isub;
|
|
kusano |
7d535a |
z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
z_div(&z__1, &z__2, &dl[jsub]);
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 5) {
|
|
kusano |
7d535a |
i__1 = isub;
|
|
kusano |
7d535a |
z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
d_cnjg(&z__3, &dl[jsub]);
|
|
kusano |
7d535a |
z__1.r = z__2.r * z__3.r - z__2.i * z__3.i, z__1.i = z__2.r * z__3.i
|
|
kusano |
7d535a |
+ z__2.i * z__3.r;
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 6) {
|
|
kusano |
7d535a |
i__1 = isub;
|
|
kusano |
7d535a |
z__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, z__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
i__2 = jsub;
|
|
kusano |
7d535a |
z__1.r = z__2.r * dl[i__2].r - z__2.i * dl[i__2].i, z__1.i = z__2.r *
|
|
kusano |
7d535a |
dl[i__2].i + z__2.i * dl[i__2].r;
|
|
kusano |
7d535a |
ctemp.r = z__1.r, ctemp.i = z__1.i;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
ret_val->r = ctemp.r, ret_val->i = ctemp.i;
|
|
kusano |
7d535a |
return ;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* End of ZLATM2 */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
} /* zlatm2_ */
|
|
kusano |
7d535a |
|