|
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 |
/* Complex */ VOID clatm3_(complex * ret_val, integer *m, integer *n, integer
|
|
kusano |
7d535a |
*i, integer *j, integer *isub, integer *jsub, integer *kl, integer *
|
|
kusano |
7d535a |
ku, integer *idist, integer *iseed, complex *d, integer *igrade,
|
|
kusano |
7d535a |
complex *dl, complex *dr, integer *ipvtng, integer *iwork, real *
|
|
kusano |
7d535a |
sparse)
|
|
kusano |
7d535a |
{
|
|
kusano |
7d535a |
/* System generated locals */
|
|
kusano |
7d535a |
integer i__1, i__2;
|
|
kusano |
7d535a |
complex q__1, q__2, q__3;
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Builtin functions */
|
|
kusano |
7d535a |
void c_div(complex *, complex *, complex *), r_cnjg(complex *, complex *);
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Local variables */
|
|
kusano |
7d535a |
static complex ctemp;
|
|
kusano |
7d535a |
extern /* Complex */ VOID clarnd_(complex *, integer *, integer *);
|
|
kusano |
7d535a |
extern doublereal slaran_(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 |
CLATM3 returns the (ISUB,JSUB) entry of a random matrix of
|
|
kusano |
7d535a |
dimension (M, N) described by the other paramters. (ISUB,JSUB)
|
|
kusano |
7d535a |
is the final position of the (I,J) entry after pivoting
|
|
kusano |
7d535a |
according to IPVTNG and IWORK. CLATM3 is called by the
|
|
kusano |
7d535a |
CLATMR 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 CLATMR which has already checked the parameters.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
Use of CLATM3 differs from CLATM2 in the order in which the random
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
number generator is called to fill in random matrix entries.
|
|
kusano |
7d535a |
With CLATM2, the generator is called to fill in the pivoted matrix
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
columnwise. With CLATM3, the generator is called to fill in the
|
|
kusano |
7d535a |
matrix columnwise, after which it is pivoted. Thus, CLATM3 can
|
|
kusano |
7d535a |
be used to construct random matrices which differ only in their
|
|
kusano |
7d535a |
order of rows and/or columns. CLATM2 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 |
in different orders for different pivot orders).
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
The matrix whose (ISUB,JSUB) entry is returned is constructed as
|
|
kusano |
7d535a |
follows (this routine only computes one entry):
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
If ISUB is outside (1..M) or JSUB is outside (1..N), return zero
|
|
kusano |
7d535a |
|
|
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 unpivoted entry to be returned. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
J - INTEGER
|
|
kusano |
7d535a |
Column of unpivoted entry to be returned. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
ISUB - INTEGER
|
|
kusano |
7d535a |
Row of pivoted entry to be returned. Changed on exit.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
JSUB - INTEGER
|
|
kusano |
7d535a |
Column of pivoted entry to be returned. Changed on exit.
|
|
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 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 array ( I or J, as appropriate )
|
|
kusano |
7d535a |
Left scale factors for grading matrix. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
DR - COMPLEX 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) originally in position K is in
|
|
kusano |
7d535a |
position IWORK( K ) after pivoting.
|
|
kusano |
7d535a |
This differs from IWORK for CLATM2. Not modified.
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
SPARSE - REAL 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 |
*isub = *i;
|
|
kusano |
7d535a |
*jsub = *j;
|
|
kusano |
7d535a |
ret_val->r = 0.f, ret_val->i = 0.f;
|
|
kusano |
7d535a |
return ;
|
|
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 |
/* Check for banding */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*jsub > *isub + *ku || *jsub < *isub - *kl) {
|
|
kusano |
7d535a |
ret_val->r = 0.f, ret_val->i = 0.f;
|
|
kusano |
7d535a |
return ;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Check for sparsity */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*sparse > 0.f) {
|
|
kusano |
7d535a |
if (slaran_(&iseed[1]) < *sparse) {
|
|
kusano |
7d535a |
ret_val->r = 0.f, ret_val->i = 0.f;
|
|
kusano |
7d535a |
return ;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
/* Compute entry and grade it according to IGRADE */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
if (*i == *j) {
|
|
kusano |
7d535a |
i__1 = *i;
|
|
kusano |
7d535a |
ctemp.r = d[i__1].r, ctemp.i = d[i__1].i;
|
|
kusano |
7d535a |
} else {
|
|
kusano |
7d535a |
clarnd_(&q__1, idist, &iseed[1]);
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__1.i;
|
|
kusano |
7d535a |
}
|
|
kusano |
7d535a |
if (*igrade == 1) {
|
|
kusano |
7d535a |
i__1 = *i;
|
|
kusano |
7d535a |
q__1.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, q__1.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 2) {
|
|
kusano |
7d535a |
i__1 = *j;
|
|
kusano |
7d535a |
q__1.r = ctemp.r * dr[i__1].r - ctemp.i * dr[i__1].i, q__1.i =
|
|
kusano |
7d535a |
ctemp.r * dr[i__1].i + ctemp.i * dr[i__1].r;
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 3) {
|
|
kusano |
7d535a |
i__1 = *i;
|
|
kusano |
7d535a |
q__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, q__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
i__2 = *j;
|
|
kusano |
7d535a |
q__1.r = q__2.r * dr[i__2].r - q__2.i * dr[i__2].i, q__1.i = q__2.r *
|
|
kusano |
7d535a |
dr[i__2].i + q__2.i * dr[i__2].r;
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 4 && *i != *j) {
|
|
kusano |
7d535a |
i__1 = *i;
|
|
kusano |
7d535a |
q__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, q__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
c_div(&q__1, &q__2, &dl[*j]);
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 5) {
|
|
kusano |
7d535a |
i__1 = *i;
|
|
kusano |
7d535a |
q__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, q__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
r_cnjg(&q__3, &dl[*j]);
|
|
kusano |
7d535a |
q__1.r = q__2.r * q__3.r - q__2.i * q__3.i, q__1.i = q__2.r * q__3.i
|
|
kusano |
7d535a |
+ q__2.i * q__3.r;
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__1.i;
|
|
kusano |
7d535a |
} else if (*igrade == 6) {
|
|
kusano |
7d535a |
i__1 = *i;
|
|
kusano |
7d535a |
q__2.r = ctemp.r * dl[i__1].r - ctemp.i * dl[i__1].i, q__2.i =
|
|
kusano |
7d535a |
ctemp.r * dl[i__1].i + ctemp.i * dl[i__1].r;
|
|
kusano |
7d535a |
i__2 = *j;
|
|
kusano |
7d535a |
q__1.r = q__2.r * dl[i__2].r - q__2.i * dl[i__2].i, q__1.i = q__2.r *
|
|
kusano |
7d535a |
dl[i__2].i + q__2.i * dl[i__2].r;
|
|
kusano |
7d535a |
ctemp.r = q__1.r, ctemp.i = q__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 CLATM3 */
|
|
kusano |
7d535a |
|
|
kusano |
7d535a |
} /* clatm3_ */
|
|
kusano |
7d535a |
|