/*
------------------------------
purpose -- to permute a vector
y[*] := y[index[*]]
created -- 95sep22, cca
------------------------------
*/
void
DVperm (
int size,
double y[],
int index[]
) {
if ( size > 0 ) {
if ( y == NULL || index == NULL ) {
fprintf(stderr, "\n fatal error in DVperm, invalid data"
"\n size = %d, y = %p, index = %p\n", size, y, index) ;
exit(-1) ;
} else {
double *x ;
int i ;
x = DVinit2(size) ;
DVcopy(size, x, y) ;
for ( i = 0 ; i < size ; i++ ) {
y[i] = x[index[i]] ;
}
DVfree(x) ;
}
}
return ; }
/*
-------------------------------------------------------
purpose -- given the pair of arrays (x1[],y1[]),
create a pair of arrays (x2[],y2[]) whose
entries are pairwise chosen from (x1[],y1[])
and whose distribution is an approximation.
return value -- the size of the (x2[],y2[]) arrays
created -- 95sep22, cca
-------------------------------------------------------
*/
int
IVcompress (
int size1,
int x1[],
int y1[],
int size2,
int x2[],
int y2[]
) {
double delta, dx, dy, path, totalPath ;
double *ds ;
int i, j ;
/*
--------------------
check the input data
--------------------
*/
if ( size1 <= 0 || size2 <= 0 ) {
return(0) ;
} else if ( x1 == NULL || y1 == NULL || x2 == NULL || y2 == NULL ) {
fprintf(stderr, "\n fatal error in IVcompress, invalid data"
"\n size1 = %d, x1 = %p, y1 = %p"
"\n size2 = %d, x2 = %p, y2 = %p\n",
size1, x1, y1, size2, x2, y2) ;
exit(-1) ;
}
/*
----------------------------------------
compute the path length and its segments
----------------------------------------
*/
ds = DVinit(size1, 0.0) ;
for ( j = 1 ; j < size1 ; j++ ) {
dx = x1[j] - x1[j-1] ;
dy = y1[j] - y1[j-1] ;
ds[j-1] = sqrt((double) (dx*dx + dy*dy)) ;
}
totalPath = DVsum(size1, ds) ;
delta = totalPath / (size2-2) ;
#if MYDEBUG > 0
fprintf(stdout, "\n totalPath = %12.4e, delta = %12.4e, ds",
totalPath, delta) ;
DVfprintf(stdout, size1, ds) ;
#endif
/*
---------------------
fill the second array
---------------------
*/
i = 0 ;
x2[i] = x1[i] ;
y2[i] = y1[i] ;
i++ ;
path = 0. ;
for ( j = 1 ; j < size1 - 1 ; j++ ) {
path += ds[j-1] ;
#if MYDEBUG > 0
fprintf(stdout, "\n j %d, path %12.4e", j, path) ;
#endif
if ( path >= delta ) {
#if MYDEBUG > 0
fprintf(stdout, ", accepted") ;
#endif
x2[i] = x1[j] ;
y2[i] = y1[j] ;
i++ ;
path = 0. ;
}
}
x2[i] = x1[size1-1] ;
y2[i] = y1[size1-1] ;
i++ ;
/*
------------------------
free the working storage
------------------------
*/
DVfree(ds) ;
return(i) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
--------------------------------------------------------------------
this program tests the Graph_MPI_Bcast() method
(1) process root generates a random Graph object
and computes its checksum
(2) process root broadcasts the Graph object to the other processors
(3) each process computes the checksum of its Graph object
(4) the checksums are compared on root
created -- 98sep10, cca
--------------------------------------------------------------------
*/
{
char *buffer ;
double chksum, t1, t2 ;
double *sums ;
Drand drand ;
int iproc, length, loc, msglvl, myid, nitem, nproc,
nvtx, root, seed, size, type, v ;
int *list ;
FILE *msgFile ;
Graph *graph ;
/*
---------------------------------------------------------------
find out the identity of this process and the number of process
---------------------------------------------------------------
*/
MPI_Init(&argc, &argv) ;
MPI_Comm_rank(MPI_COMM_WORLD, &myid) ;
MPI_Comm_size(MPI_COMM_WORLD, &nproc) ;
fprintf(stdout, "\n process %d of %d, argc = %d", myid, nproc, argc) ;
fflush(stdout) ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type nvtx nitem root seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- type of graph"
"\n nvtx -- # of vertices"
"\n nitem -- # of items used to generate graph"
"\n root -- root processor for broadcast"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else {
length = strlen(argv[2]) + 1 + 4 ;
buffer = CVinit(length, '\0') ;
sprintf(buffer, "%s.%d", argv[2], myid) ;
if ( (msgFile = fopen(buffer, "w")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
CVfree(buffer) ;
}
type = atoi(argv[3]) ;
nvtx = atoi(argv[4]) ;
nitem = atoi(argv[5]) ;
root = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n type -- %d"
"\n nvtx -- %d"
"\n nitem -- %d"
"\n root -- %d"
"\n seed -- %d"
"\n",
argv[0], msglvl, argv[2], type, nvtx, nitem, root, seed) ;
fflush(msgFile) ;
/*
-----------------------
set up the Graph object
-----------------------
*/
MARKTIME(t1) ;
graph = Graph_new() ;
if ( myid == root ) {
InpMtx *inpmtx ;
int nedges, totewght, totvwght, v ;
int *adj, *vwghts ;
IVL *adjIVL, *ewghtIVL ;
/*
-----------------------
generate a random graph
-----------------------
*/
inpmtx = InpMtx_new() ;
InpMtx_init(inpmtx, INPMTX_BY_ROWS, INPMTX_INDICES_ONLY, nitem, 0) ;
Drand_setDefaultFields(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, 0, nvtx) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec1(inpmtx)) ;
Drand_fillIvector(&drand, nitem, InpMtx_ivec2(inpmtx)) ;
InpMtx_setNent(inpmtx, nitem) ;
InpMtx_changeStorageMode(inpmtx, INPMTX_BY_VECTORS) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n inpmtx mtx filled with raw entries") ;
InpMtx_writeForHumanEye(inpmtx, msgFile) ;
fflush(msgFile) ;
}
adjIVL = InpMtx_fullAdjacency(inpmtx) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n full adjacency structure") ;
IVL_writeForHumanEye(adjIVL, msgFile) ;
fflush(msgFile) ;
}
nedges = adjIVL->tsize ;
if ( type == 1 || type == 3 ) {
Drand_setUniform(&drand, 1, 10) ;
vwghts = IVinit(nvtx, 0) ;
Drand_fillIvector(&drand, nvtx, vwghts) ;
totvwght = IVsum(nvtx, vwghts) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n vertex weights") ;
IVfprintf(msgFile, nvtx, vwghts) ;
fflush(msgFile) ;
}
} else {
vwghts = NULL ;
totvwght = nvtx ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totvwght %d", totvwght) ;
fflush(msgFile) ;
}
if ( type == 2 || type == 3 ) {
ewghtIVL = IVL_new() ;
IVL_init1(ewghtIVL, IVL_CHUNKED, nvtx) ;
Drand_setUniform(&drand, 1, 100) ;
totewght = 0 ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(adjIVL, v, &size, &adj) ;
IVL_setList(ewghtIVL, v, size, NULL) ;
IVL_listAndSize(ewghtIVL, v, &size, &adj) ;
Drand_fillIvector(&drand, size, adj) ;
totewght += IVsum(size, adj) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ewghtIVL") ;
IVL_writeForHumanEye(ewghtIVL, msgFile) ;
fflush(msgFile) ;
}
} else {
ewghtIVL = NULL ;
totewght = nedges ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n totewght %d", totewght) ;
fflush(msgFile) ;
}
Graph_init2(graph, type, nvtx, 0, nedges, totvwght, totewght,
adjIVL, vwghts, ewghtIVL) ;
InpMtx_free(inpmtx) ;
}
MARKTIME(t2) ;
fprintf(msgFile,
"\n CPU %8.3f : initialize the Graph object", t2 - t1) ;
fflush(msgFile) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
fflush(msgFile) ;
if ( myid == root ) {
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
}
/*
--------------------------
broadcast the Graph object
--------------------------
*/
MARKTIME(t1) ;
graph = Graph_MPI_Bcast(graph, root, msglvl, msgFile, MPI_COMM_WORLD) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : broadcast the Graph object", t2 - t1) ;
if ( msglvl > 2 ) {
Graph_writeForHumanEye(graph, msgFile) ;
} else {
Graph_writeStats(graph, msgFile) ;
}
/*
----------------------------------------
compute the checksum of the Graph object
----------------------------------------
*/
chksum = graph->type + graph->nvtx + graph->nvbnd
+ graph->nedges + graph->totvwght + graph->totewght ;
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->adjIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
if ( graph->vwghts != NULL ) {
chksum += IVsum(nvtx, graph->vwghts) ;
}
if ( graph->ewghtIVL != NULL ) {
for ( v = 0 ; v < nvtx ; v++ ) {
IVL_listAndSize(graph->ewghtIVL, v, &size, &list) ;
chksum += 1 + v + size + IVsum(size, list) ;
}
}
fprintf(msgFile, "\n\n local chksum = %12.4e", chksum) ;
fflush(msgFile) ;
/*
---------------------------------------
gather the checksums from the processes
---------------------------------------
*/
sums = DVinit(nproc, 0.0) ;
MPI_Gather((void *) &chksum, 1, MPI_DOUBLE,
(void *) sums, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD) ;
if ( myid == 0 ) {
fprintf(msgFile, "\n\n sums") ;
DVfprintf(msgFile, nproc, sums) ;
for ( iproc = 0 ; iproc < nproc ; iproc++ ) {
sums[iproc] -= chksum ;
}
fprintf(msgFile, "\n\n errors") ;
DVfprintf(msgFile, nproc, sums) ;
fprintf(msgFile, "\n\n maxerror = %12.4e", DVmax(nproc, sums, &loc));
}
/*
----------------
free the objects
----------------
*/
DVfree(sums) ;
Graph_free(graph) ;
/*
------------------------
exit the MPI environment
------------------------
*/
MPI_Finalize() ;
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return(0) ; }
/*
----------------------------------------------
sort the rows of the matrix in ascending order
of the rowids[] vector. on return, rowids is
in asending order. return value is the number
of row swaps made.
created -- 98apr15, cca
----------------------------------------------
*/
int
A2_sortRowsUp (
A2 *mtx,
int nrow,
int rowids[]
) {
int ii, minrow, minrowid, nswap, target ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || mtx->n1 < nrow || nrow < 0 || rowids == NULL ) {
fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
"\n bad input\n", mtx, nrow, rowids) ;
if ( mtx != NULL ) {
A2_writeStats(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, nrow, rowids, mtx->type) ;
exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc1 == 1 ) {
double *dvtmp ;
int jcol, ncol ;
int *ivtmp ;
/*
---------------------------------------------------
matrix is stored by columns, so permute each column
---------------------------------------------------
*/
ivtmp = IVinit(nrow, -1) ;
if ( A2_IS_REAL(mtx) ) {
dvtmp = DVinit(nrow, 0.0) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
dvtmp = DVinit(2*nrow, 0.0) ;
}
IVramp(nrow, ivtmp, 0, 1) ;
IV2qsortUp(nrow, rowids, ivtmp) ;
ncol = mtx->n2 ;
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
if ( A2_IS_REAL(mtx) ) {
DVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
DVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
ZVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
ZVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
}
}
IVfree(ivtmp) ;
DVfree(dvtmp) ;
} else {
/*
----------------------------------------
use a simple insertion sort to swap rows
----------------------------------------
*/
for ( target = 0 ; target < nrow ; target++ ) {
minrow = target ;
minrowid = rowids[target] ;
for ( ii = target + 1 ; ii < nrow ; ii++ ) {
if ( minrowid > rowids[ii] ) {
minrow = ii ;
minrowid = rowids[ii] ;
}
}
if ( minrow != target ) {
rowids[minrow] = rowids[target] ;
rowids[target] = minrowid ;
A2_swapRows(mtx, target, minrow) ;
nswap++ ;
}
}
}
return(nswap) ; }
/*
-------------------------------------------------
sort the columns of the matrix in ascending order
of the colids[] vector. on return, colids is
in asending order. return value is the number
of column swaps made.
created -- 98apr15, cca
-------------------------------------------------
*/
int
A2_sortColumnsUp (
A2 *mtx,
int ncol,
int colids[]
) {
int ii, mincol, mincolid, nswap, target ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || mtx->n2 < ncol || ncol < 0 || colids == NULL ) {
fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
"\n bad input\n", mtx, ncol, colids) ;
if ( mtx != NULL ) {
A2_writeStats(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, ncol, colids, mtx->type) ;
exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc2 == 1 ) {
double *dvtmp ;
int irow, nrow ;
int *ivtmp ;
/*
---------------------------------------------------
matrix is stored by rows, so permute each row
---------------------------------------------------
*/
ivtmp = IVinit(ncol, -1) ;
if ( A2_IS_REAL(mtx) ) {
dvtmp = DVinit(ncol, 0.0) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
dvtmp = DVinit(2*ncol, 0.0) ;
}
IVramp(ncol, ivtmp, 0, 1) ;
IV2qsortUp(ncol, colids, ivtmp) ;
nrow = mtx->n1 ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
if ( A2_IS_REAL(mtx) ) {
DVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
DVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
ZVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
ZVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
}
}
IVfree(ivtmp) ;
DVfree(dvtmp) ;
} else {
/*
----------------------------------------
use a simple insertion sort to swap cols
----------------------------------------
*/
for ( target = 0 ; target < ncol ; target++ ) {
mincol = target ;
mincolid = colids[target] ;
for ( ii = target + 1 ; ii < ncol ; ii++ ) {
if ( mincolid > colids[ii] ) {
mincol = ii ;
mincolid = colids[ii] ;
}
}
if ( mincol != target ) {
colids[mincol] = colids[target] ;
colids[target] = mincolid ;
A2_swapColumns(mtx, target, mincol) ;
nswap++ ;
}
}
}
return(nswap) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
------------------------------------
test the copyEntriesToVector routine
created -- 98may01, cca,
------------------------------------
*/
{
Chv *chvJ, *chvI ;
double imag, real, t1, t2 ;
double *dvec, *entries ;
Drand *drand ;
FILE *msgFile ;
int count, first, ierr, ii, iilast, ipivot, irow, jcol, jj,
jjlast, maxnent, mm, msglvl, ncol, nD, nent, nentD, nentL,
nentL11, nentL21, nentU, nentU11, nentU12, nL, npivot, nrow,
nU, pivotingflag, seed, storeflag, symflag, total, type ;
int *colind, *pivotsizes, *rowind ;
if ( argc != 10 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nD nU type symflag "
"\n pivotingflag storeflag seed"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nD -- # of rows and columns in the (1,1) block"
"\n nU -- # of columns in the (1,2) block"
"\n type -- entries type"
"\n 1 --> real"
"\n 2 --> complex"
"\n symflag -- symmetry flag"
"\n 0 --> symmetric"
"\n 1 --> nonsymmetric"
"\n pivotingflag -- pivoting flag"
"\n if symflag = 1 and pivotingflag = 1 then"
"\n construct pivotsizes[] vector"
"\n endif"
"\n storeflag -- flag to denote how to store entries"
"\n 0 --> store by rows"
"\n 1 --> store by columns"
"\n seed -- random number seed"
"\n", argv[0]) ;
return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
fprintf(stderr, "\n message level must be positive\n") ;
exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
return(-1) ;
}
nD = atoi(argv[3]) ;
nU = atoi(argv[4]) ;
type = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
pivotingflag = atoi(argv[7]) ;
storeflag = atoi(argv[8]) ;
seed = atoi(argv[9]) ;
if ( msglvl > 0 ) {
switch ( storeflag ) {
case 0 : fprintf(msgFile, "\n\n %% STORE BY ROWS") ; break ;
case 1 : fprintf(msgFile, "\n\n %% STORE BY COLUMNS") ; break ;
default :
fprintf(stderr, "\n bad value %d for storeflag", storeflag) ;
break ;
}
}
nL = nU ;
if ( symflag == SPOOLES_NONSYMMETRIC ) {
pivotingflag = 0 ;
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setNormal(drand, 0.0, 1.0) ;
Drand_setSeed(drand, seed) ;
/*
--------------------------
initialize the chvJ object
--------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
t2 - t1) ;
nent = Chv_nent(chvJ) ;
entries = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
Drand_fillDvector(drand, 2*nent, entries) ;
}
Chv_columnIndices(chvJ, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
Chv_rowIndices(chvJ, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chevron a") ;
Chv_writeForMatlab(chvJ, "a", msgFile) ;
fflush(msgFile) ;
}
/*
--------------------------
initialize the chvI object
--------------------------
*/
MARKTIME(t1) ;
chvI = Chv_new() ;
Chv_init(chvI, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix objects",
t2 - t1) ;
Chv_zero(chvI) ;
Chv_columnIndices(chvI, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
Chv_rowIndices(chvI, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
if ( symflag == 0 && pivotingflag == 1 ) {
/*
------------------------------
create the pivotsizes[] vector
------------------------------
*/
Drand_setUniform(drand, 1, 2.999) ;
pivotsizes = IVinit(nD, 0) ;
Drand_fillIvector(drand, nD, pivotsizes) ;
/*
fprintf(msgFile, "\n initial pivotsizes[] : ") ;
IVfp80(msgFile, nD, pivotsizes, 80, &ierr) ;
*/
for ( npivot = count = 0 ; npivot < nD ; npivot++ ) {
count += pivotsizes[npivot] ;
if ( count > nD ) {
pivotsizes[npivot]-- ;
count-- ;
}
if ( count == nD ) {
break ;
}
}
npivot++ ;
/*
fprintf(msgFile, "\n final pivotsizes[] : ") ;
IVfp80(msgFile, npivot, pivotsizes, 80, &ierr) ;
*/
} else {
npivot = 0 ;
pivotsizes = NULL ;
}
/*
--------------------------------------------------
first test: copy lower, diagonal and upper entries
--------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
nentL = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_LOWER);
} else {
nentL = 0 ;
}
nentD = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_STRICT_UPPER) ;
maxnent = nentL ;
if ( maxnent < nentD ) { maxnent = nentD ; }
if ( maxnent < nentU ) { maxnent = nentU ; }
if ( CHV_IS_REAL(chvJ) ) {
dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
dvec = DVinit(2*maxnent, 0.0) ;
}
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
--------------------------------------
copy the entries in the lower triangle,
then move into the chvI object
--------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_LOWER, storeflag) ;
if ( nent != nentL ) {
fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
exit(-1) ;
}
if ( storeflag == 0 ) {
for ( irow = 0, mm = 0 ; irow < nrow ; irow++ ) {
jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jj, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ;
imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
}
}
}
} else {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
for ( irow = jcol + 1 ; irow < nrow ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
/*
fprintf(msgFile, "\n %% mm = %d, a(%d,%d) = %20.12e + %20.12e*i",
mm, irow, jcol, real, imag) ;
*/
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
}
/*
---------------------------------------
copy the entries in the diagonal matrix
then move into the chvI object
---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
exit(-1) ;
}
if ( pivotsizes == NULL ) {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, jcol, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
}
mm++ ; irow++ ;
} else {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow+1, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
mm++ ;
irow += 2 ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
mm++ ;
irow += 2 ;
}
}
}
}
/*
--------------------------------------
copy the entries in the upper triangle,
then move into the chvI object
--------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_UPPER, storeflag) ;
if ( nent != nentU ) {
fprintf(stderr, "\n error: nentU = %d, nent = %d", nentU, nent) ;
exit(-1) ;
}
if ( storeflag == 1 ) {
if ( pivotsizes == NULL ) {
for ( jcol = mm = 0 ; jcol < ncol ; jcol++ ) {
iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
iilast = jcol - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
if ( pivotsizes[ipivot] == 2 ) {
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
}
}
for ( jcol = nD ; jcol < ncol ; jcol++ ) {
for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
} else {
if ( pivotsizes == NULL ) {
for ( irow = mm = 0 ; irow < nD ; irow++ ) {
for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
for ( jcol = irow + 1 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
irow++ ;
} else {
for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
for ( jcol = irow + 2 ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
}
}
irow += 2 ;
}
}
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chevron b") ;
Chv_writeForMatlab(chvI, "b", msgFile) ;
fprintf(msgFile,
"\n\n emtx1 = abs(a - b) ; enorm1 = max(max(emtx1))") ;
fflush(msgFile) ;
}
DVfree(dvec) ;
/*
-----------------------------------------------------
second test: copy lower (1,1), lower (2,1), diagonal,
upper(1,1) and upper(1,2) blocks
-----------------------------------------------------
*/
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
nentL11 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_STRICT_LOWER_11) ;
nentL21 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_LOWER_21) ;
} else {
nentL11 = 0 ;
nentL21 = 0 ;
}
nentD = Chv_countEntries(chvJ, npivot, pivotsizes, CHV_DIAGONAL) ;
nentU11 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_STRICT_UPPER_11) ;
nentU12 = Chv_countEntries(chvJ, npivot, pivotsizes,
CHV_UPPER_12) ;
maxnent = nentL11 ;
if ( maxnent < nentL21 ) { maxnent = nentL21 ; }
if ( maxnent < nentD ) { maxnent = nentD ; }
if ( maxnent < nentU11 ) { maxnent = nentU11 ; }
if ( maxnent < nentU12 ) { maxnent = nentU12 ; }
fprintf(msgFile,
"\n %% nentL11 = %d, nentL21 = %d"
"\n %% nentD = %d, nentU11 = %d, nentU12 = %d",
nentL11, nentL21, nentD, nentU11, nentU12) ;
if ( CHV_IS_REAL(chvJ) ) {
dvec = DVinit(maxnent, 0.0) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
dvec = DVinit(2*maxnent, 0.0) ;
}
Chv_zero(chvI) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
/*
------------------------------------------
copy the entries in the lower (1,1) block,
then move into the chvI object
------------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_LOWER_11, storeflag) ;
if ( nent != nentL11 ) {
fprintf(stderr, "\n error: nentL = %d, nent = %d", nentL, nent) ;
exit(-1) ;
}
if ( storeflag == 0 ) {
for ( irow = 0, mm = 0 ; irow < nD ; irow++ ) {
jjlast = (irow < nD) ? irow - 1 : nD - 1 ;
for ( jj = 0 ; jj <= jjlast ; jj++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jj, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jj, real, imag) ;
}
}
}
} else {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
for ( irow = jcol + 1 ; irow < nD ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
/*
------------------------------------------
copy the entries in the lower (2,1) block,
then move into the chvI object
------------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_LOWER_21, storeflag);
if ( nent != nentL21 ) {
fprintf(stderr, "\n error: nentL21 = %d, nent = %d",
nentL21, nent) ;
exit(-1) ;
}
if ( storeflag == 0 ) {
for ( irow = nD, mm = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++ ) {
for ( irow = nD ; irow < nrow ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
}
/*
---------------------------------------
copy the entries in the diagonal matrix
then move into the chvI object
---------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_DIAGONAL, storeflag) ;
if ( nent != nentD ) {
fprintf(stderr, "\n error: nentD = %d, nent = %d", nentD, nent) ;
exit(-1) ;
}
if ( pivotsizes == NULL ) {
for ( jcol = 0, mm = 0 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, jcol, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, jcol, jcol, real, imag) ;
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
}
mm++ ; irow++ ;
} else {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, irow+1, real) ;
mm++ ;
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, irow+1, real) ;
mm++ ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, irow+1, real, imag) ;
mm++ ;
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, irow+1, real, imag) ;
mm++ ;
}
irow += 2 ;
}
}
}
/*
-----------------------------------------
copy the entries in the upper (1,1) block
then move into the chvI object
-----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_STRICT_UPPER_11, storeflag) ;
if ( nent != nentU11 ) {
fprintf(stderr, "\n error: nentU11 = %d, nent = %d", nentU11, nent) ;
exit(-1) ;
}
if ( storeflag == 1 ) {
if ( pivotsizes == NULL ) {
for ( jcol = mm = 0 ; jcol < nD ; jcol++ ) {
iilast = (jcol < nD) ? jcol - 1 : nD - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = jcol = mm = 0 ; ipivot < npivot ; ipivot++ ) {
iilast = jcol - 1 ;
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
if ( pivotsizes[ipivot] == 2 ) {
for ( ii = 0 ; ii <= iilast ; ii++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, ii, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, ii, jcol, real, imag) ;
}
}
jcol++ ;
}
}
}
} else {
if ( pivotsizes == NULL ) {
for ( irow = mm = 0 ; irow < nD ; irow++ ) {
for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( ipivot = irow = mm = 0 ; ipivot < npivot ; ipivot++ ) {
if ( pivotsizes[ipivot] == 1 ) {
for ( jcol = irow + 1 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
irow++ ;
} else {
for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
for ( jcol = irow + 2 ; jcol < nD ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow+1, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow+1, jcol, real, imag) ;
}
}
irow += 2 ;
}
}
}
}
/*
-----------------------------------------
copy the entries in the upper (1,2) block
then move into the chvI object
-----------------------------------------
*/
nent = Chv_copyEntriesToVector(chvJ, npivot, pivotsizes, maxnent,
dvec, CHV_UPPER_12, storeflag) ;
if ( nent != nentU12 ) {
fprintf(stderr, "\n error: nentU12 = %d, nent = %d", nentU12, nent) ;
exit(-1) ;
}
if ( storeflag == 1 ) {
for ( jcol = nD, mm = 0 ; jcol < ncol ; jcol++ ) {
for ( irow = 0 ; irow < nD ; irow++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
} else {
for ( irow = mm = 0 ; irow < nD ; irow++ ) {
for ( jcol = nD ; jcol < ncol ; jcol++, mm++ ) {
if ( CHV_IS_REAL(chvJ) ) {
real = dvec[mm] ;
Chv_setRealEntry(chvI, irow, jcol, real) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
real = dvec[2*mm] ; imag = dvec[2*mm+1] ;
Chv_setComplexEntry(chvI, irow, jcol, real, imag) ;
}
}
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chevron b") ;
Chv_writeForMatlab(chvI, "b", msgFile) ;
fprintf(msgFile,
"\n\n emtx2 = abs(a - b) ; enorm2 = max(max(emtx2))") ;
fprintf(msgFile, "\n\n [ enorm1 enorm2]") ;
fflush(msgFile) ;
}
/*
------------------------
free the working storage
------------------------
*/
if ( pivotsizes != NULL ) {
IVfree(pivotsizes) ;
}
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;
DVfree(dvec) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
------------------------------------------------------------------
generate a random matrix and test a matrix-matrix multiply method.
the output is a matlab file to test correctness.
created -- 98jan29, cca
--------------------------------------------------------------------
*/
{
DenseMtx *X, *Y, *Y2 ;
double alpha[2] ;
double alphaImag, alphaReal, t1, t2 ;
double *zvec ;
Drand *drand ;
int col, dataType, ii, msglvl, ncolA, nitem, nops, nrhs,
nrowA, nrowX, nrowY, nthread, row, seed,
storageMode, symflag, transposeflag ;
int *colids, *rowids ;
InpMtx *A ;
FILE *msgFile ;
if ( argc != 15 ) {
fprintf(stdout,
"\n\n %% usage : %s msglvl msgFile symflag storageMode "
"\n %% nrow ncol nent nrhs seed alphaReal alphaImag nthread"
"\n %% msglvl -- message level"
"\n %% msgFile -- message file"
"\n %% dataType -- type of matrix entries"
"\n %% 1 -- real"
"\n %% 2 -- complex"
"\n %% symflag -- symmetry flag"
"\n %% 0 -- symmetric"
"\n %% 1 -- hermitian"
"\n %% 2 -- nonsymmetric"
"\n %% storageMode -- storage mode"
"\n %% 1 -- by rows"
"\n %% 2 -- by columns"
"\n %% 3 -- by chevrons, (requires nrow = ncol)"
"\n %% transpose -- transpose flag"
"\n %% 0 -- Y := Y + alpha * A * X"
"\n %% 1 -- Y := Y + alpha * A^H * X, nonsymmetric only"
"\n %% 2 -- Y := Y + alpha * A^T * X, nonsymmetric only"
"\n %% nrowA -- number of rows in A"
"\n %% ncolA -- number of columns in A"
"\n %% nitem -- number of items"
"\n %% nrhs -- number of right hand sides"
"\n %% seed -- random number seed"
"\n %% alphaReal -- y := y + alpha*A*x"
"\n %% alphaImag -- y := y + alpha*A*x"
"\n %% nthread -- # of threads"
"\n", argv[0]) ;
return(0) ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
return(-1) ;
}
dataType = atoi(argv[3]) ;
symflag = atoi(argv[4]) ;
storageMode = atoi(argv[5]) ;
transposeflag = atoi(argv[6]) ;
nrowA = atoi(argv[7]) ;
ncolA = atoi(argv[8]) ;
nitem = atoi(argv[9]) ;
nrhs = atoi(argv[10]) ;
seed = atoi(argv[11]) ;
alphaReal = atof(argv[12]) ;
alphaImag = atof(argv[13]) ;
nthread = atoi(argv[14]) ;
fprintf(msgFile,
"\n %% %s "
"\n %% msglvl -- %d"
"\n %% msgFile -- %s"
"\n %% dataType -- %d"
"\n %% symflag -- %d"
"\n %% storageMode -- %d"
"\n %% transposeflag -- %d"
"\n %% nrowA -- %d"
"\n %% ncolA -- %d"
"\n %% nitem -- %d"
"\n %% nrhs -- %d"
"\n %% seed -- %d"
"\n %% alphaReal -- %e"
"\n %% alphaImag -- %e"
"\n %% nthread -- %d"
"\n",
argv[0], msglvl, argv[2], dataType, symflag, storageMode,
transposeflag, nrowA, ncolA, nitem, nrhs, seed,
alphaReal, alphaImag, nthread) ;
fflush(msgFile) ;
if ( dataType != 1 && dataType != 2 ) {
fprintf(stderr, "\n invalid value %d for dataType\n", dataType) ;
spoolesFatal();
}
if ( symflag != 0 && symflag != 1 && symflag != 2 ) {
fprintf(stderr, "\n invalid value %d for symflag\n", symflag) ;
spoolesFatal();
}
if ( storageMode != 1 && storageMode != 2 && storageMode != 3 ) {
fprintf(stderr,
"\n invalid value %d for storageMode\n", storageMode) ;
spoolesFatal();
}
if ( transposeflag < 0
|| transposeflag > 2 ) {
fprintf(stderr, "\n error, transposeflag = %d, must be 0, 1 or 2",
transposeflag) ;
spoolesFatal();
}
if ( (transposeflag == 1 && symflag != 2)
|| (transposeflag == 2 && symflag != 2) ) {
fprintf(stderr, "\n error, transposeflag = %d, symflag = %d",
transposeflag, symflag) ;
spoolesFatal();
}
if ( transposeflag == 1 && dataType != 2 ) {
fprintf(stderr, "\n error, transposeflag = %d, dataType = %d",
transposeflag, dataType) ;
spoolesFatal();
}
if ( symflag == 1 && dataType != 2 ) {
fprintf(stderr,
"\n symflag = 1 (hermitian), dataType != 2 (complex)") ;
spoolesFatal();
}
if ( nrowA <= 0 || ncolA <= 0 || nitem <= 0 ) {
fprintf(stderr,
"\n invalid value: nrow = %d, ncol = %d, nitem = %d",
nrowA, ncolA, nitem) ;
spoolesFatal();
}
if ( symflag < 2 && nrowA != ncolA ) {
fprintf(stderr,
"\n invalid data: symflag = %d, nrow = %d, ncol = %d",
symflag, nrowA, ncolA) ;
spoolesFatal();
}
alpha[0] = alphaReal ;
alpha[1] = alphaImag ;
/*
----------------------------
initialize the matrix object
----------------------------
*/
A = InpMtx_new() ;
InpMtx_init(A, storageMode, dataType, 0, 0) ;
drand = Drand_new() ;
/*
----------------------------------
generate a vector of nitem triples
----------------------------------
*/
rowids = IVinit(nitem, -1) ;
Drand_setUniform(drand, 0, nrowA) ;
Drand_fillIvector(drand, nitem, rowids) ;
colids = IVinit(nitem, -1) ;
Drand_setUniform(drand, 0, ncolA) ;
Drand_fillIvector(drand, nitem, colids) ;
Drand_setUniform(drand, 0.0, 1.0) ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
zvec = DVinit(nitem, 0.0) ;
Drand_fillDvector(drand, nitem, zvec) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
zvec = ZVinit(nitem, 0.0, 0.0) ;
Drand_fillDvector(drand, 2*nitem, zvec) ;
}
/*
-----------------------------------
assemble the entries entry by entry
-----------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n A = zeros(%d,%d) ;", nrowA, ncolA) ;
}
if ( symflag == 1 ) {
/*
----------------
hermitian matrix
----------------
*/
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] == colids[ii] ) {
zvec[2*ii+1] = 0.0 ;
}
if ( rowids[ii] <= colids[ii] ) {
row = rowids[ii] ; col = colids[ii] ;
} else {
row = colids[ii] ; col = rowids[ii] ;
}
InpMtx_inputComplexEntry(A, row, col, zvec[2*ii], zvec[2*ii+1]) ;
}
} else if ( symflag == 0 ) {
/*
----------------
symmetric matrix
----------------
*/
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] <= colids[ii] ) {
row = rowids[ii] ; col = colids[ii] ;
} else {
row = colids[ii] ; col = rowids[ii] ;
}
InpMtx_inputRealEntry(A, row, col, zvec[ii]) ;
}
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] <= colids[ii] ) {
row = rowids[ii] ; col = colids[ii] ;
} else {
row = colids[ii] ; col = rowids[ii] ;
}
InpMtx_inputComplexEntry(A, row, col,
zvec[2*ii], zvec[2*ii+1]) ;
}
}
} else {
/*
-------------------
nonsymmetric matrix
-------------------
*/
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
InpMtx_inputRealEntry(A, rowids[ii], colids[ii], zvec[ii]) ;
}
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
InpMtx_inputComplexEntry(A, rowids[ii], colids[ii],
zvec[2*ii], zvec[2*ii+1]) ;
}
}
}
InpMtx_changeStorageMode(A, INPMTX_BY_VECTORS) ;
DVfree(zvec) ;
if ( symflag == 0 || symflag == 1 ) {
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
nops = 4*A->nent*nrhs ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
nops = 16*A->nent*nrhs ;
}
} else {
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
nops = 2*A->nent*nrhs ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
nops = 8*A->nent*nrhs ;
}
}
if ( msglvl > 1 ) {
/*
-------------------------------------------
write the assembled matrix to a matlab file
-------------------------------------------
*/
InpMtx_writeForMatlab(A, "A", msgFile) ;
if ( symflag == 0 ) {
fprintf(msgFile,
"\n for k = 1:%d"
"\n for j = k+1:%d"
"\n A(j,k) = A(k,j) ;"
"\n end"
"\n end", nrowA, ncolA) ;
} else if ( symflag == 1 ) {
fprintf(msgFile,
"\n for k = 1:%d"
"\n for j = k+1:%d"
"\n A(j,k) = ctranspose(A(k,j)) ;"
"\n end"
"\n end", nrowA, ncolA) ;
}
}
/*
-------------------------------
generate dense matrices X and Y
-------------------------------
*/
if ( transposeflag == 0 ) {
nrowX = ncolA ;
nrowY = nrowA ;
} else {
nrowX = nrowA ;
nrowY = ncolA ;
}
X = DenseMtx_new() ;
Y = DenseMtx_new() ;
Y2 = DenseMtx_new() ;
if ( INPMTX_IS_REAL_ENTRIES(A) ) {
DenseMtx_init(X, SPOOLES_REAL, 0, 0, nrowX, nrhs, 1, nrowX) ;
Drand_fillDvector(drand, nrowX*nrhs, DenseMtx_entries(X)) ;
DenseMtx_init(Y, SPOOLES_REAL, 0, 0, nrowY, nrhs, 1, nrowY) ;
Drand_fillDvector(drand, nrowY*nrhs, DenseMtx_entries(Y)) ;
DenseMtx_init(Y2, SPOOLES_REAL, 0, 0, nrowY, nrhs, 1, nrowY) ;
DVcopy(nrowY*nrhs, DenseMtx_entries(Y2), DenseMtx_entries(Y)) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(A) ) {
DenseMtx_init(X, SPOOLES_COMPLEX, 0, 0, nrowX, nrhs, 1, nrowX) ;
Drand_fillDvector(drand, 2*nrowX*nrhs, DenseMtx_entries(X)) ;
DenseMtx_init(Y, SPOOLES_COMPLEX, 0, 0, nrowY, nrhs, 1, nrowY) ;
Drand_fillDvector(drand, 2*nrowY*nrhs, DenseMtx_entries(Y)) ;
DenseMtx_init(Y2, SPOOLES_COMPLEX, 0, 0, nrowY, nrhs, 1, nrowY) ;
DVcopy(2*nrowY*nrhs, DenseMtx_entries(Y2), DenseMtx_entries(Y)) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n X = zeros(%d,%d) ;", nrowX, nrhs) ;
DenseMtx_writeForMatlab(X, "X", msgFile) ;
fprintf(msgFile, "\n Y = zeros(%d,%d) ;", nrowY, nrhs) ;
DenseMtx_writeForMatlab(Y, "Y", msgFile) ;
}
/*
--------------------------------------------
perform the matrix-matrix multiply in serial
--------------------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n alpha = %20.12e + %20.2e*i;",
alpha[0], alpha[1]);
fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
}
if ( transposeflag == 0 ) {
MARKTIME(t1) ;
if ( symflag == 0 ) {
InpMtx_sym_mmm(A, Y, alpha, X) ;
} else if ( symflag == 1 ) {
InpMtx_herm_mmm(A, Y, alpha, X) ;
} else if ( symflag == 2 ) {
InpMtx_nonsym_mmm(A, Y, alpha, X) ;
}
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
fprintf(msgFile, "\n maxerr = max(Z - Y - alpha*A*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 1 ) {
MARKTIME(t1) ;
InpMtx_nonsym_mmm_H(A, Y, alpha, X) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
fprintf(msgFile,
"\n maxerr = max(Z - Y - alpha*ctranspose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 2 ) {
MARKTIME(t1) ;
InpMtx_nonsym_mmm_T(A, Y, alpha, X) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y, "Z", msgFile) ;
fprintf(msgFile,
"\n maxerr = max(Z - Y - alpha*transpose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
}
fprintf(msgFile, "\n %% %d ops, %.3f time, %.3f serial mflops",
nops, t2 - t1, 1.e-6*nops/(t2 - t1)) ;
/*
--------------------------------------------------------
perform the matrix-matrix multiply in multithreaded mode
--------------------------------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile,
"\n alpha = %20.12e + %20.2e*i;", alpha[0], alpha[1]);
fprintf(msgFile, "\n Z = zeros(%d,1) ;", nrowY) ;
}
if ( transposeflag == 0 ) {
MARKTIME(t1) ;
if ( symflag == 0 ) {
InpMtx_MT_sym_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
} else if ( symflag == 1 ) {
InpMtx_MT_herm_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
} else if ( symflag == 2 ) {
InpMtx_MT_nonsym_mmm(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
}
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
fprintf(msgFile, "\n maxerr2 = max(Z2 - Y - alpha*A*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 1 ) {
MARKTIME(t1) ;
InpMtx_MT_nonsym_mmm_H(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
fprintf(msgFile,
"\n maxerr2 = max(Z2 - Y - alpha*ctranspose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
} else if ( transposeflag == 2 ) {
MARKTIME(t1) ;
InpMtx_MT_nonsym_mmm_T(A, Y2, alpha, X, nthread, msglvl, msgFile) ;
MARKTIME(t2) ;
if ( msglvl > 1 ) {
DenseMtx_writeForMatlab(Y2, "Z2", msgFile) ;
fprintf(msgFile,
"\n maxerr2 = max(Z2 - Y - alpha*transpose(A)*X) ") ;
fprintf(msgFile, "\n") ;
}
}
fprintf(msgFile, "\n %% %d ops, %.3f time, %.3f MT mflops",
nops, t2 - t1, 1.e-6*nops/(t2 - t1)) ;
/*
------------------------
free the working storage
------------------------
*/
InpMtx_free(A) ;
DenseMtx_free(X) ;
DenseMtx_free(Y) ;
DenseMtx_free(Y2) ;
IVfree(rowids) ;
IVfree(colids) ;
Drand_free(drand) ;
fclose(msgFile) ;
return(1) ; }
/*
----------------------------------
set the maximum size of the vector
created -- 96dec08, cca
----------------------------------
*/
void
DV_setMaxsize (
DV *dv,
int newmaxsize
) {
/*
---------------
check the input
---------------
*/
if ( dv == NULL || newmaxsize < 0 ) {
fprintf(stderr, "\n fatal error in DV_setMaxsize(%p,%d)"
"\n bad input\n", dv, newmaxsize) ;
spoolesFatal();
}
if ( dv->maxsize > 0 && dv->owned == 0 ) {
fprintf(stderr, "\n fatal error in DV_setMaxsize(%p,%d)"
"\n dv->maxsize = %d, dv->owned = %d\n",
dv, newmaxsize, dv->maxsize, dv->owned) ;
spoolesFatal();
}
if ( dv->maxsize != newmaxsize ) {
/*
-----------------------------------
allocate new storage for the vector
-----------------------------------
*/
double *vec ;
/*
vec = DVinit(newmaxsize, 0.0) ;
*/
vec = DVinit2(newmaxsize) ;
if ( dv->size > 0 ) {
/*
---------------------------------
copy old entries into new entries
---------------------------------
*/
if ( dv->vec == NULL ) {
fprintf(stderr, "\n fatal error in DV_setMaxsize(%p,%d)"
"\n dv->size = %d, dv->vec is NULL\n",
dv, newmaxsize, dv->size) ;
spoolesFatal();
}
if ( dv->size <= newmaxsize ) {
DVcopy(dv->size, vec, dv->vec) ;
} else {
/*
-----------------------
note, data is truncated
-----------------------
*/
DVcopy(newmaxsize, vec, dv->vec) ;
dv->size = newmaxsize ;
}
}
if ( dv->vec != NULL ) {
/*
----------------
free old entries
----------------
*/
DVfree(dv->vec) ;
}
/*
----------
set fields
----------
*/
dv->maxsize = newmaxsize ;
dv->owned = 1 ;
dv->vec = vec ;
}
return ; }
/*
----------------------------------
set the maximum size of the vector
created -- 98jan22, cca
----------------------------------
*/
void
ZV_setMaxsize (
ZV *zv,
int newmaxsize
) {
/*
---------------
check the input
---------------
*/
if ( zv == NULL || newmaxsize < 0 ) {
fprintf(stderr, "\n fatal error in ZV_setMaxsize(%p,%d)"
"\n bad input\n", zv, newmaxsize) ;
exit(-1) ;
}
if ( zv->maxsize > 0 && zv->owned == 0 ) {
fprintf(stderr, "\n fatal error in ZV_setMaxsize(%p,%d)"
"\n zv->maxsize = %d, zv->owned = %d\n",
zv, newmaxsize, zv->maxsize, zv->owned) ;
exit(-1) ;
}
if ( zv->maxsize != newmaxsize ) {
/*
-----------------------------------
allocate new storage for the vector
-----------------------------------
*/
double *vec = DVinit(2*newmaxsize, 0.0) ;
if ( zv->size > 0 ) {
/*
---------------------------------
copy old entries into new entries
---------------------------------
*/
if ( zv->vec == NULL ) {
fprintf(stderr, "\n fatal error in ZV_setMaxsize(%p,%d)"
"\n zv->size = %d, zv->vec is NULL\n",
zv, newmaxsize, zv->size) ;
exit(-1) ;
}
if ( zv->size <= newmaxsize ) {
DVcopy(2*zv->size, vec, zv->vec) ;
} else {
/*
-----------------------
note, data is truncated
-----------------------
*/
DVcopy(2*newmaxsize, vec, zv->vec) ;
zv->size = newmaxsize ;
}
}
if ( zv->vec != NULL ) {
/*
----------------
free old entries
----------------
*/
DVfree(zv->vec) ;
}
/*
----------
set fields
----------
*/
zv->maxsize = newmaxsize ;
zv->owned = 1 ;
zv->vec = vec ;
}
return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------
test the Chv_addChevron() method.
created -- 98apr18, cca
---------------------------------------
*/
{
Chv *chv ;
double alpha[2] ;
double imag, real, t1, t2 ;
double *chvent, *entries ;
Drand *drand ;
FILE *msgFile ;
int chvsize, count, ichv, ierr, ii, iloc, irow, jcol,
lastcol, msglvl, ncol, nD, nent, nL, nrow, nU,
off, seed, symflag, type, upper ;
int *chvind, *colind, *keys, *rowind, *temp ;
if ( argc != 10 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nD nU type symflag seed "
"\n alphareal alphaimag"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nD -- # of rows and columns in the (1,1) block"
"\n nU -- # of columns in the (1,2) block"
"\n type -- entries type"
"\n 1 --> real"
"\n 2 --> complex"
"\n symflag -- symmetry flag"
"\n 0 --> symmetric"
"\n 1 --> hermitian"
"\n 2 --> nonsymmetric"
"\n seed -- random number seed"
"\n alpha -- scaling parameter"
"\n", argv[0]) ;
return(0) ;
}
if ( (msglvl = atoi(argv[1])) < 0 ) {
fprintf(stderr, "\n message level must be positive\n") ;
exit(-1) ;
}
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n unable to open file %s\n", argv[2]) ;
return(-1) ;
}
nD = atoi(argv[3]) ;
nU = atoi(argv[4]) ;
type = atoi(argv[5]) ;
symflag = atoi(argv[6]) ;
seed = atoi(argv[7]) ;
alpha[0] = atof(argv[8]) ;
alpha[1] = atof(argv[9]) ;
if ( nD <= 0 || nU < 0 || symflag < 0 || symflag > 2 ) {
fprintf(stderr, "\n invalid input"
"\n nD = %d, nU = %d, symflag = %d\n", nD, nU, symflag) ;
exit(-1) ;
}
fprintf(msgFile, "\n alpha = %12.4e + %12.4e*i ;", alpha[0], alpha[1]) ;
nL = nU ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
----------------------------
initialize the Chv object
----------------------------
*/
MARKTIME(t1) ;
chv = Chv_new() ;
Chv_init(chv, 0, nD, nL, nU, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chv, &ncol, &colind) ;
temp = IVinit(2*(nD+nU), -1) ;
IVramp(2*(nD+nU), temp, 0, 1) ;
IVshuffle(2*(nD+nU), temp, ++seed) ;
IVcopy(ncol, colind, temp) ;
IVqsortUp(ncol, colind) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
Chv_rowIndices(chv, &nrow, &rowind) ;
IVcopy(nrow, rowind, colind) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %% column indices") ;
IVfprintf(msgFile, ncol, colind) ;
}
lastcol = colind[ncol-1] ;
nent = Chv_nent(chv) ;
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
Drand_fillDvector(drand, nent, entries) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
Drand_fillDvector(drand, 2*nent, entries) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
/*
---------------------------------------------------------
hermitian example, set imaginary part of diagonal to zero
---------------------------------------------------------
*/
for ( irow = 0 ; irow < nD ; irow++ ) {
Chv_complexEntry(chv, irow, irow, &real, &imag) ;
Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chv, "a", msgFile) ;
}
/*
--------------------------------------------------
fill a chevron with random numbers and indices
that are a subset of a front's, as in the assembly
of original matrix entries.
--------------------------------------------------
*/
Drand_setUniform(drand, 0, nD) ;
iloc = (int) Drand_value(drand) ;
ichv = colind[iloc] ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
upper = nD - iloc + nU ;
} else {
upper = 2*(nD - iloc) - 1 + nL + nU ;
}
Drand_setUniform(drand, 1, upper) ;
chvsize = (int) Drand_value(drand) ;
fprintf(msgFile, "\n %% iloc = %d, ichv = %d, chvsize = %d",
iloc, ichv, chvsize) ;
chvind = IVinit(chvsize, -1) ;
chvent = DVinit(2*chvsize, 0.0) ;
Drand_setNormal(drand, 0.0, 1.0) ;
if ( CHV_IS_REAL(chv) ) {
Drand_fillDvector(drand, chvsize, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
Drand_fillDvector(drand, 2*chvsize, chvent) ;
}
keys = IVinit(upper+1, -1) ;
keys[0] = 0 ;
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
keys[count++] = colind[ii] - ichv ;
}
} else {
for ( ii = iloc + 1, count = 1 ; ii < nD + nU ; ii++ ) {
keys[count++] = colind[ii] - ichv ;
keys[count++] = - colind[ii] + ichv ;
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% iloc = %d, ichv = %d", iloc, ichv) ;
fprintf(msgFile, "\n %% upper = %d", upper) ;
fprintf(msgFile, "\n %% chvsize = %d", chvsize) ;
fprintf(msgFile, "\n %% initial keys") ;
IVfprintf(msgFile, count, keys) ;
}
IVshuffle(count, keys, ++seed) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% shuffled keys") ;
IVfp80(msgFile, count, keys, 80, &ierr) ;
}
IVcopy(chvsize, chvind, keys) ;
if ( CHV_IS_REAL(chv) ) {
IVDVqsortUp(chvsize, chvind, chvent) ;
} else if ( CHV_IS_COMPLEX(chv) ) {
IVZVqsortUp(chvsize, chvind, chvent) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% chvind") ;
IVfprintf(msgFile, chvsize, chvind) ;
}
if ( CHV_IS_HERMITIAN(chv) ) {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
if ( chvind[ii] == 0 ) {
chvent[2*ii+1] = 0.0 ;
}
}
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) ) {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]+off+1, colind[iloc]+1, chvent[ii]) ;
}
} else {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
if ( off > 0 ) {
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]+1, colind[iloc]+off+1, chvent[ii]) ;
} else {
fprintf(msgFile, "\n b(%d,%d) = %20.12e ;",
colind[iloc]-off+1, colind[iloc]+1, chvent[ii]) ;
}
}
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+1, colind[iloc]+off+1,
chvent[2*ii], chvent[2*ii+1]) ;
if ( CHV_IS_HERMITIAN(chv) ) {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+off+1, colind[iloc]+1,
chvent[2*ii], -chvent[2*ii+1]) ;
} else {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+off+1, colind[iloc]+1,
chvent[2*ii], chvent[2*ii+1]) ;
}
}
} else {
for ( ii = 0 ; ii < chvsize ; ii++ ) {
off = chvind[ii] ;
if ( off > 0 ) {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]+1, colind[iloc]+off+1,
chvent[2*ii], chvent[2*ii+1]) ;
} else {
fprintf(msgFile, "\n b(%d,%d) = %20.12e + %20.12e*i;",
colind[iloc]-off+1, colind[iloc]+1,
chvent[2*ii], chvent[2*ii+1]) ;
}
}
}
}
}
/*
------------------------------------
add the chevron into the Chv object
------------------------------------
*/
Chv_addChevron(chv, alpha, ichv, chvsize, chvind, chvent) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n %% after adding the chevron") ;
fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chv, "c", msgFile) ;
}
/*
-----------------
compute the error
-----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (a + alpha*b))))") ;
/*
------------------------
free the working storage
------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
IVfree(temp) ;
IVfree(chvind) ;
DVfree(chvent) ;
IVfree(keys) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*
----------------------------------------------------------------
purpose -- to create an InpMtx object filled with random entries
input --
mtx -- matrix object, if NULL, it is created
inputMode -- input mode for the object,
indices only, real or complex entries
coordType -- coordinate type for the object,
by rows, by columns or by chevrons
storageMode -- storage mode for the object,
raw data, sorted or by vectors
nrow -- # of rows
ncol -- # of columns
symflag -- symmetry flag for the matrix,
symmetric, hermitian or nonsymmetric
nonzerodiag -- if 1, entries are placed on the diagonal
nitem -- # of items to be placed into the matrix
seed -- random number seed
return value ---
1 -- normal return
-1 -- mtx is NULL
-2 -- bad input mode
-3 -- bad coordinate type
-4 -- bad storage mode
-5 -- nrow or ncol <= 0
-6 -- bad symmetry flag
-7 -- hermitian matrix but not complex
-8 -- symmetric or hermitian matrix but nrow != ncol
-9 -- nitem < 0
----------------------------------------------------------------
*/
int
InpMtx_randomMatrix (
InpMtx *mtx,
int inputMode,
int coordType,
int storageMode,
int nrow,
int ncol,
int symflag,
int nonzerodiag,
int nitem,
int seed
) {
double *dvec ;
Drand *drand ;
int col, ii, neqns, row ;
int *colids, *rowids ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n mtx is NULL\n") ;
return(-1) ;
}
switch ( inputMode ) {
case INPMTX_INDICES_ONLY :
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
break ;
default :
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n bad input mode %d\n", inputMode) ;
return(-2) ;
break ;
}
switch ( coordType ) {
case INPMTX_BY_ROWS :
case INPMTX_BY_COLUMNS :
case INPMTX_BY_CHEVRONS :
break ;
default :
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n bad coordinate type %d\n", coordType) ;
return(-3) ;
break ;
}
switch ( storageMode ) {
case INPMTX_RAW_DATA :
case INPMTX_SORTED :
case INPMTX_BY_VECTORS :
break ;
default :
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n bad storage mode%d\n", storageMode) ;
return(-4) ;
break ;
}
if ( nrow <= 0 || ncol <= 0 ) {
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n nrow = %d, ncol = %d\n", nrow, ncol) ;
return(-5) ;
}
switch ( symflag ) {
case SPOOLES_SYMMETRIC :
case SPOOLES_HERMITIAN :
case SPOOLES_NONSYMMETRIC :
break ;
default :
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n bad symmetry flag%d\n", symflag) ;
return(-6) ;
break ;
}
if ( symflag == SPOOLES_HERMITIAN && inputMode != SPOOLES_COMPLEX ) {
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n symmetryflag is Hermitian, requires complex type\n") ;
return(-7) ;
}
if ( (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
&& nrow != ncol ) {
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n symmetric or hermitian matrix, nrow %d, ncol%d\n",
nrow, ncol) ;
return(-8) ;
}
if ( nitem < 0 ) {
fprintf(stderr, "\n fatal error in InpMtx_randomMatrix"
"\n nitem = %d\n", nitem) ;
return(-9) ;
}
/*--------------------------------------------------------------------*/
neqns = (nrow <= ncol) ? nrow : ncol ;
if ( nonzerodiag == 1 ) {
nitem += neqns ;
}
/*
---------------------
initialize the object
---------------------
*/
InpMtx_init(mtx, INPMTX_BY_ROWS, inputMode, nitem, 0) ;
/*
----------------
fill the triples
----------------
*/
drand = Drand_new() ;
Drand_setSeed(drand, seed) ;
rowids = IVinit(nitem, -1) ;
colids = IVinit(nitem, -1) ;
if ( nonzerodiag == 1 ) {
IVramp(neqns, rowids, 0, 1) ;
Drand_setUniform(drand, 0, nrow) ;
Drand_fillIvector(drand, nitem - neqns, rowids + neqns) ;
Drand_setUniform(drand, 0, ncol) ;
IVramp(neqns, colids, 0, 1) ;
Drand_fillIvector(drand, nitem - neqns, colids + neqns) ;
} else {
Drand_setUniform(drand, 0, nrow) ;
Drand_fillIvector(drand, nitem, rowids) ;
Drand_setUniform(drand, 0, ncol) ;
Drand_fillIvector(drand, nitem, colids) ;
}
if ( symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( (row = rowids[ii]) > (col = colids[ii]) ) {
rowids[ii] = col ;
colids[ii] = row ;
}
}
}
if ( inputMode == SPOOLES_REAL ) {
dvec = DVinit(nitem, 0.0) ;
Drand_setUniform(drand, 0.0, 1.0) ;
Drand_fillDvector(drand, nitem, dvec) ;
} else if ( inputMode == SPOOLES_COMPLEX ) {
dvec = DVinit(2*nitem, 0.0) ;
Drand_setUniform(drand, 0.0, 1.0) ;
Drand_fillDvector(drand, 2*nitem, dvec) ;
if ( symflag == SPOOLES_HERMITIAN ) {
for ( ii = 0 ; ii < nitem ; ii++ ) {
if ( rowids[ii] == colids[ii] ) {
dvec[2*ii+1] = 0.0 ;
}
}
}
} else {
dvec = NULL ;
}
/*
----------------
load the triples
----------------
*/
switch ( inputMode ) {
case INPMTX_INDICES_ONLY :
InpMtx_inputTriples(mtx, nitem, rowids, colids) ;
break ;
case SPOOLES_REAL :
InpMtx_inputRealTriples(mtx, nitem, rowids, colids, dvec) ;
break ;
case SPOOLES_COMPLEX :
InpMtx_inputComplexTriples(mtx, nitem, rowids, colids, dvec) ;
break ;
}
/*
----------------------------------------
set the coordinate type and storage mode
----------------------------------------
*/
InpMtx_changeCoordType(mtx, coordType) ;
InpMtx_changeStorageMode(mtx, storageMode) ;
/*
------------------------
free the working storage
------------------------
*/
Drand_free(drand) ;
IVfree(rowids) ;
IVfree(colids) ;
if ( dvec != NULL ) {
DVfree(dvec) ;
}
return(1) ; }
/*
------------------------------------------------------------------
to fill xDV and yDV with a log10 profile of the magnitudes of
the entries in the DV object. tausmall and tau big provide
cutoffs within which to examine the entries. pnzero, pnsmall
and pnbig are addresses to hold the number of entries zero,
smaller than tausmall and larger than taubig, respectively.
created -- 97feb14, cca
------------------------------------------------------------------
*/
void
DV_log10profile (
DV *dv,
int npts,
DV *xDV,
DV *yDV,
double tausmall,
double taubig,
int *pnzero,
int *pnsmall,
int *pnbig
) {
double deltaVal, maxval, minval, val ;
double *dvec, *sums, *x, *y ;
int ii, ipt, nbig, nsmall, nzero, size ;
/*
---------------
check the input
---------------
*/
if ( dv == NULL || npts <= 0 || xDV == NULL || yDV == NULL
|| tausmall < 0.0 || taubig < 0.0 || tausmall > taubig
|| pnzero == NULL || pnsmall == NULL || pnbig == NULL ) {
fprintf(stderr,
"\n fatal error in DV_log10profile(%p,%d,%p,%p,%f,%f,%p,%p,%p)"
"\n bad input\n",
dv, npts, xDV, yDV, tausmall, taubig, pnzero, pnsmall, pnbig) ;
exit(-1) ;
}
/*
-------------------------------------
find the largest and smallest entries
in the range [tausmall, taubig]
-------------------------------------
*/
nbig = nsmall = nzero = 0 ;
minval = maxval = 0.0 ;
DV_sizeAndEntries(dv, &size, &dvec) ;
for ( ii = 0 ; ii < size ; ii++ ) {
val = fabs(dvec[ii]) ;
if ( val == 0.0 ) {
nzero++ ;
} else if ( val <= tausmall ) {
nsmall++ ;
} else if ( val >= taubig ) {
nbig++ ;
} else {
if ( minval == 0.0 || minval > val ) {
minval = val ;
}
if ( maxval < val ) {
maxval = val ;
}
}
}
*pnzero = nzero ;
*pnsmall = nsmall ;
*pnbig = nbig ;
#if MYDEBUG > 0
fprintf(stdout,
"\n nzero = %d, minval = %e, nsmall = %d, maxval = %e, nbig = %d",
nzero, minval, nsmall, maxval, nbig) ;
#endif
/*
------------------
set up the buckets
------------------
*/
DV_setSize(xDV, npts) ;
DV_setSize(yDV, npts) ;
x = DV_entries(xDV) ;
y = DV_entries(yDV) ;
sums = DVinit(npts, 0.0) ;
minval = log10(minval) ;
maxval = log10(maxval) ;
/*
minval = log10(tausmall) ;
maxval = log10(taubig) ;
*/
deltaVal = (maxval - minval)/(npts - 1) ;
DVfill(npts, x, 0.0) ;
DVfill(npts, y, 0.0) ;
/*
--------------------------------
fill the sums and counts vectors
--------------------------------
*/
for ( ii = 0 ; ii < size ; ii++ ) {
val = fabs(dvec[ii]) ;
if ( tausmall < val && val < taubig ) {
ipt = (log10(val) - minval) / deltaVal ;
sums[ipt] += val ;
y[ipt]++ ;
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n sum(y) = %.0f", DV_sum(yDV)) ;
#endif
/*
---------------------------
set the x-coordinate vector
---------------------------
*/
for ( ipt = 0 ; ipt < npts ; ipt++ ) {
if ( sums[ipt] == 0.0 ) {
x[ipt] = minval + ipt*deltaVal ;
} else {
x[ipt] = log10(sums[ipt]/y[ipt]) ;
}
}
/*
------------------------
free the working storage
------------------------
*/
DVfree(sums) ;
return ; }
