/*
----------------------------
purpose -- basic initializer
created -- 98may02, cca
----------------------------
*/
void
DenseMtx_init (
DenseMtx *mtx,
int type,
int rowid,
int colid,
int nrow,
int ncol,
int inc1,
int inc2
) {
int nbytes ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || nrow < 0 || ncol < 0
|| !((inc1 == ncol && inc2 == 1) || (inc1 == 1 && inc2 == nrow)) ) {
fprintf(stderr,
"\n fatal error in DenseMtx_init(%p,%d,%d,%d,%d,%d,%d)"
"\n bad input\n",
mtx, rowid, colid, nrow, ncol, inc1, inc2) ;
exit(-1) ;
}
switch ( type ) {
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
break ;
default :
fprintf(stderr,
"\n fatal error in DenseMtx_init(%p,%d,%d,%d,%d,%d,%d,%d)"
"\n bad type %d\n",
mtx, type, rowid, colid, nrow, ncol, inc1, inc2, type) ;
exit(-1) ;
break ;
}
/*
-------------------------------------------------------
get and set the number of bytes needed in the workspace
-------------------------------------------------------
*/
nbytes = DenseMtx_nbytesNeeded(type, nrow, ncol) ;
DenseMtx_setNbytesInWorkspace(mtx, nbytes) ;
/*
--------------
set the fields
--------------
*/
DenseMtx_setFields(mtx, type, rowid, colid, nrow, ncol, inc1, inc2) ;
if ( nrow > 0 ) {
IVramp(nrow, mtx->rowind, 0, 1) ;
}
if ( ncol > 0 ) {
IVramp(ncol, mtx->colind, 0, 1) ;
}
return ; }
/*
-------------------------------------------------
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) ; }
/*
----------------------------------------------------------------
purpose -- for each L_{bnd{J},J} matrix, remove from hash table,
split into their L_{K,J} submatrices and insert
into the hash table.
created -- 98may04, cca
----------------------------------------------------------------
*/
void
FrontMtx_splitLowerMatrices (
FrontMtx *frontmtx,
int msglvl,
FILE *msgFile
) {
SubMtx *mtxLJ, *mtxLJJ, *mtxLKJ ;
SubMtxManager *manager ;
double *entLJ, *entLKJ ;
int count, first, ii, inc1, inc2, irow, jj, J, K, nbytes,
ncolLJ, ncolLKJ, nentLJ, nentLKJ, neqns, nfront, nJ,
nrowJ, nrowLJ, nrowLKJ, offset, v ;
int *colindLJ, *colindLKJ, *rowmap, *indicesLJ, *indicesLKJ,
*locmap, *rowindJ, *rowindLJ, *rowindLKJ, *sizesLJ,
*sizesLKJ ;
I2Ohash *lowerhash ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr,
"\n fatal error in FrontMtx_splitLowerMatrices(%p,%d,%p)"
"\n bad input\n", frontmtx, msglvl, msgFile) ;
spoolesFatal();
}
nfront = FrontMtx_nfront(frontmtx) ;
neqns = FrontMtx_neqns(frontmtx) ;
lowerhash = frontmtx->lowerhash ;
manager = frontmtx->manager ;
/*
--------------------------------
construct the row and local maps
--------------------------------
*/
rowmap = IVinit(neqns, -1) ;
locmap = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_rowIndices(frontmtx, J, &nrowJ, &rowindJ) ;
if ( nrowJ > 0 && rowindJ != NULL ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
v = rowindJ[ii] ;
rowmap[v] = J ;
locmap[v] = ii ;
}
}
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n rowmap[]") ;
IVfprintf(msgFile, neqns, rowmap) ;
fprintf(msgFile, "\n\n locmap[]") ;
IVfprintf(msgFile, neqns, locmap) ;
fflush(msgFile) ;
}
/*
---------------------------------------------
move the L_{J,J} matrices into the hash table
---------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtxLJJ = FrontMtx_lowerMtx(frontmtx, J, J)) != NULL ) {
I2Ohash_insert(frontmtx->lowerhash, J, J, mtxLJJ) ;
}
}
/*
------------------------------------------------------------
now split the L_{bnd{J},J} matrices into L_{K,J} matrices.
note: columns of L_{bnd{J},J} are assumed to be in ascending
order with respect to the column ordering of the matrix.
------------------------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
mtxLJ = FrontMtx_lowerMtx(frontmtx, nfront, J) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ### J = %d, mtxLJ = %p", J, mtxLJ) ;
fflush(msgFile) ;
}
if ( mtxLJ != NULL ) {
if ( msglvl > 2 ) {
SubMtx_writeForHumanEye(mtxLJ, msgFile) ;
fflush(msgFile) ;
}
SubMtx_columnIndices(mtxLJ, &ncolLJ, &colindLJ) ;
SubMtx_rowIndices(mtxLJ, &nrowLJ, &rowindLJ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n column indices for J") ;
IVfprintf(msgFile, ncolLJ, colindLJ) ;
fprintf(msgFile, "\n row indices for LJ") ;
IVfprintf(msgFile, nrowLJ, rowindLJ) ;
fflush(msgFile) ;
}
if ( (K = rowmap[rowindLJ[0]]) == rowmap[rowindLJ[nrowLJ-1]] ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front %d supports only %d", J, K) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------
L_{bnd{J},J} is one submatrix, bnd{J} \subseteq K
set row and column indices and change column id
-------------------------------------------------
*/
IVramp(ncolLJ, colindLJ, 0, 1) ;
for ( ii = 0 ; ii < nrowLJ ; ii++ ) {
rowindLJ[ii] = locmap[rowindLJ[ii]] ;
}
/*
mtxLJ->rowid = K ;
*/
SubMtx_setFields(mtxLJ, mtxLJ->type, mtxLJ->mode, K, J,
mtxLJ->nrow, mtxLJ->ncol, mtxLJ->nent) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ## inserting L(%d,%d) ", K, J) ;
SubMtx_writeForHumanEye(mtxLJ, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(lowerhash, K, J, (void *) mtxLJ) ;
} else {
/*
-----------------------------------
split L_{bnd{J},J} into submatrices
-----------------------------------
*/
nJ = FrontMtx_frontSize(frontmtx, J) ;
if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
SubMtx_denseInfo(mtxLJ,
&nrowLJ, &ncolLJ, &inc1, &inc2, &entLJ) ;
} else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
SubMtx_sparseRowsInfo(mtxLJ, &nrowLJ, &nentLJ,
&sizesLJ, &indicesLJ, &entLJ) ;
offset = 0 ;
count = sizesLJ[0] ;
}
first = 0 ;
K = rowmap[rowindLJ[0]] ;
for ( irow = 1 ; irow <= nrowLJ ; irow++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n irow = %d", irow) ;
if ( irow < nrowLJ ) {
fprintf(msgFile, ", rowmap[%d] = %d",
rowindLJ[irow], rowmap[rowindLJ[irow]]);
}
fflush(msgFile) ;
}
if ( irow == nrowLJ || K != rowmap[rowindLJ[irow]] ) {
nrowLKJ = irow - first ;
if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
nentLKJ = nJ*nrowLKJ ;
} else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
if ( count == 0 ) {
goto no_entries ;
}
nentLKJ = count ;
}
nbytes = SubMtx_nbytesNeeded(mtxLJ->type, mtxLJ->mode,
nrowLKJ, nJ, nentLKJ) ;
mtxLKJ = SubMtxManager_newObjectOfSizeNbytes(manager,
nbytes) ;
SubMtx_init(mtxLKJ, mtxLJ->type, mtxLJ->mode, K, J,
nrowLKJ, nJ, nentLKJ) ;
if ( SUBMTX_IS_DENSE_ROWS(mtxLJ) ) {
SubMtx_denseInfo(mtxLKJ,
&nrowLKJ, &ncolLKJ, &inc1, &inc2, &entLKJ) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentLKJ, entLKJ, entLJ + first*nJ) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentLKJ, entLKJ, entLJ + 2*first*nJ) ;
}
} else if ( SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
SubMtx_sparseRowsInfo(mtxLKJ, &nrowLKJ, &nentLKJ,
&sizesLKJ, &indicesLKJ, &entLKJ) ;
IVcopy(nrowLKJ, sizesLKJ, sizesLJ + first) ;
IVcopy(nentLKJ, indicesLKJ, indicesLJ + offset) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentLKJ, entLKJ, entLJ + offset) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentLKJ, entLKJ, entLJ + 2*offset) ;
}
count = 0 ;
offset += nentLKJ ;
}
/*
-------------------------------------
initialize the row and column indices
-------------------------------------
*/
SubMtx_rowIndices(mtxLKJ, &nrowLKJ, &rowindLKJ) ;
for ( ii = 0, jj = first ; ii < nrowLKJ ; ii++, jj++ ) {
rowindLKJ[ii] = locmap[rowindLJ[jj]] ;
}
SubMtx_columnIndices(mtxLKJ, &ncolLKJ, &colindLKJ) ;
IVramp(ncolLKJ, colindLKJ, 0, 1) ;
/*
----------------------------------
insert L_{K,J} into the hash table
----------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n\n ## inserting L(%d,%d) ", K, J) ;
SubMtx_writeForHumanEye(mtxLKJ, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(lowerhash, K, J, (void *) mtxLKJ) ;
/*
-----------------------------------
we jump to here if there were no
entries to be stored in the matrix.
-----------------------------------
*/
no_entries :
/*
----------------------------------------------------
reset first and K to new first location and front id
----------------------------------------------------
*/
first = irow ;
if ( irow < nrowLJ ) {
K = rowmap[rowindLJ[irow]] ;
}
}
if ( irow < nrowLJ && SUBMTX_IS_SPARSE_ROWS(mtxLJ) ) {
count += sizesLJ[irow] ;
}
}
/*
--------------------------------------------
give L_{bnd{J},J} back to the matrix manager
--------------------------------------------
*/
SubMtxManager_releaseObject(manager, mtxLJ) ;
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(rowmap) ;
IVfree(locmap) ;
return ; }
/*
--------------------------------------------------------------------
purpose -- merge the front tree allowing at most
maxzeros zero entries inside a front
return --
IV object that has the old front to new front map
created -- 96jun23, cca
modified -- 97dec18, cca
bug fixed that incorrectly counted the number of zeros in a front
--------------------------------------------------------------------
*/
ETree *
ETree_mergeFrontsAny (
ETree *etree,
int maxzeros,
IV *nzerosIV
) {
ETree *etree2 ;
int J, K, nfront, nvtx, nnew ;
int *bndwghts, *cost, *fch, *map, *nodwghts,
*nzeros, *par, *place, *rep, *sib, *temp ;
IV *mapIV ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL
|| (nfront = etree->nfront) <= 0
|| (nvtx = etree->nvtx) <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d)"
"\n bad input\n", etree, maxzeros) ;
spoolesFatal();
}
if ( IV_size(nzerosIV) != nfront ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAny(%p,%d,%p)"
"\n size(nzerosIV) = %d, nfront = %d\n",
etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ;
spoolesFatal();
}
nzeros = IV_entries(nzerosIV) ;
tree = etree->tree ;
nodwghts = IVinit(nfront, 0) ;
bndwghts = IVinit(nfront, 0) ;
par = IVinit(nfront, -1) ;
fch = IVinit(nfront, -1) ;
sib = IVinit(nfront, -1) ;
IVcopy(nfront, par, tree->par) ;
IVcopy(nfront, fch, tree->fch) ;
IVcopy(nfront, sib, tree->sib) ;
IVcopy(nfront, nodwghts, IV_entries(etree->nodwghtsIV)) ;
IVcopy(nfront, bndwghts, IV_entries(etree->bndwghtsIV)) ;
/*
----------------------
set up working storage
----------------------
*/
rep = IVinit(nfront, -1) ;
IVramp(nfront, rep, 0, 1) ;
cost = IVinit(nfront, 0) ;
/*
------------------------------------------
perform a post-order traversal of the tree
------------------------------------------
*/
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
#if MYDEBUG > 0
fprintf(stdout, "\n\n ##### visiting front %d", J) ;
fflush(stdout) ;
#endif
visitAny(J, par, fch, sib, nodwghts, bndwghts,
rep, cost, nzeros, maxzeros) ;
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n whoa, finished") ;
fflush(stdout) ;
#endif
/*
-------------------------------------------------
take the map from fronts to representative fronts
and make the map from old fronts to new fronts
-------------------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map = IV_entries(mapIV) ;
place = IVinit(nfront, -1) ;
for ( J = 0, nnew = 0 ; J < nfront ; J++ ) {
#if MYDEBUG > 0
fprintf(stdout, "\n rep[%d] = %d", J, rep[J]) ;
fflush(stdout) ;
#endif
if ( rep[J] != J ) {
K = J ;
while ( rep[K] != K ) {
#if MYDEBUG > 0
fprintf(stdout, "\n rep[%d] = %d", K, rep[K]) ;
fflush(stdout) ;
#endif
K = rep[K] ;
}
rep[J] = K ;
#if MYDEBUG > 0
fprintf(stdout, "\n setting rep[%d] = %d", J, rep[J]) ;
fflush(stdout) ;
#endif
} else {
place[J] = nnew++ ;
}
}
for ( J = 0 ; J < nfront ; J++ ) {
K = rep[J] ;
map[J] = place[K] ;
}
/*
-------------------------------
get the compressed ETree object
-------------------------------
*/
etree2 = ETree_compress(etree, mapIV) ;
/*
-------------------------
remap the nzeros[] vector
-------------------------
*/
temp = IVinit(nfront, 0) ;
IVcopy(nfront, temp, nzeros) ;
IV_setSize(nzerosIV, nnew) ;
nzeros = IV_entries(nzerosIV) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( rep[J] == J ) {
nzeros[map[J]] = temp[J] ;
}
}
IVfree(temp) ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(par) ;
IVfree(fch) ;
IVfree(sib) ;
IVfree(nodwghts) ;
IVfree(bndwghts) ;
IVfree(rep) ;
IVfree(cost) ;
IVfree(place) ;
IV_free(mapIV) ;
return(etree2) ; }
/*
----------------------------------------------------------------
purpose -- for each U_{J,bnd{J}} matrix, remove from hash table,
split into their U_{J,K} submatrices and insert
into the hash table.
created -- 98may04, cca
----------------------------------------------------------------
*/
void
FrontMtx_splitUpperMatrices (
FrontMtx *frontmtx,
int msglvl,
FILE *msgFile
) {
SubMtx *mtxUJ, *mtxUJJ, *mtxUJK ;
SubMtxManager *manager ;
double *entUJ, *entUJK ;
int count, first, ii, inc1, inc2, jcol, jj, J, K, nbytes,
ncolJ, ncolUJ, ncolUJK, nentUJ, nentUJK, neqns, nfront,
nJ, nrowUJ, nrowUJK, offset, v ;
int *colindJ, *colindUJ, *colindUJK, *colmap, *indicesUJ,
*indicesUJK, *locmap, *rowindUJ, *rowindUJK, *sizesUJ,
*sizesUJK ;
I2Ohash *upperhash ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr,
"\n fatal error in FrontMtx_splitUpperMatrices(%p,%d,%p)"
"\n bad input\n", frontmtx, msglvl, msgFile) ;
spoolesFatal();
}
nfront = FrontMtx_nfront(frontmtx) ;
neqns = FrontMtx_neqns(frontmtx) ;
upperhash = frontmtx->upperhash ;
manager = frontmtx->manager ;
/*
-----------------------------------
construct the column and local maps
-----------------------------------
*/
colmap = IVinit(neqns, -1) ;
locmap = IVinit(neqns, -1) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( (nJ = FrontMtx_frontSize(frontmtx, J)) > 0 ) {
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
if ( ncolJ > 0 && colindJ != NULL ) {
for ( ii = 0 ; ii < nJ ; ii++ ) {
v = colindJ[ii] ;
colmap[v] = J ;
locmap[v] = ii ;
}
}
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n colmap[]") ;
IVfprintf(msgFile, neqns, colmap) ;
fprintf(msgFile, "\n\n locmap[]") ;
IVfprintf(msgFile, neqns, locmap) ;
fflush(msgFile) ;
}
/*
---------------------------------------------
move the U_{J,J} matrices into the hash table
---------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
if ( (mtxUJJ = FrontMtx_upperMtx(frontmtx, J, J)) != NULL ) {
I2Ohash_insert(frontmtx->upperhash, J, J, mtxUJJ) ;
}
}
/*
------------------------------------------------------------
now split the U_{J,bnd{J}} matrices into U_{J,K} matrices.
note: columns of U_{J,bnd{J}} are assumed to be in ascending
order with respect to the column ordering of the matrix.
------------------------------------------------------------
*/
for ( J = 0 ; J < nfront ; J++ ) {
mtxUJ = FrontMtx_upperMtx(frontmtx, J, nfront) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ### J = %d, mtxUJ = %p", J, mtxUJ) ;
fflush(msgFile) ;
}
if ( mtxUJ != NULL ) {
if ( msglvl > 2 ) {
SubMtx_writeForHumanEye(mtxUJ, msgFile) ;
fflush(msgFile) ;
}
SubMtx_columnIndices(mtxUJ, &ncolUJ, &colindUJ) ;
SubMtx_rowIndices(mtxUJ, &nrowUJ, &rowindUJ) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n column indices for J") ;
IVfprintf(msgFile, ncolUJ, colindUJ) ;
fprintf(msgFile, "\n row indices for UJ") ;
IVfprintf(msgFile, nrowUJ, rowindUJ) ;
fflush(msgFile) ;
}
if ( (K = colmap[colindUJ[0]]) == colmap[colindUJ[ncolUJ-1]] ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n front %d supports only %d", J, K) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------
U_{J,bnd{J}} is one submatrix, bnd{J} \subseteq K
set row and column indices and change column id
-------------------------------------------------
*/
IVramp(nrowUJ, rowindUJ, 0, 1) ;
for ( ii = 0 ; ii < ncolUJ ; ii++ ) {
colindUJ[ii] = locmap[colindUJ[ii]] ;
}
SubMtx_setFields(mtxUJ, mtxUJ->type, mtxUJ->mode, J, K,
mtxUJ->nrow, mtxUJ->ncol, mtxUJ->nent) ;
/*
mtxUJ->colid = K ;
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n ## inserting U(%d,%d) ", J, K) ;
SubMtx_writeForHumanEye(mtxUJ, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(upperhash, J, K, (void *) mtxUJ) ;
} else {
/*
-----------------------------------
split U_{J,bnd{J}} into submatrices
-----------------------------------
*/
nJ = FrontMtx_frontSize(frontmtx, J) ;
if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
SubMtx_denseInfo(mtxUJ,
&nrowUJ, &ncolUJ, &inc1, &inc2, &entUJ) ;
} else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
SubMtx_sparseColumnsInfo(mtxUJ, &ncolUJ, &nentUJ,
&sizesUJ, &indicesUJ, &entUJ) ;
offset = 0 ;
count = sizesUJ[0] ;
}
first = 0 ;
K = colmap[colindUJ[0]] ;
for ( jcol = 1 ; jcol <= ncolUJ ; jcol++ ) {
if ( msglvl > 2 ) {
fprintf(msgFile, "\n jcol = %d", jcol) ;
if ( jcol < ncolUJ ) {
fprintf(msgFile, ", colmap[%d] = %d",
colindUJ[jcol], colmap[colindUJ[jcol]]);
}
fflush(msgFile) ;
}
if ( jcol == ncolUJ || K != colmap[colindUJ[jcol]] ) {
ncolUJK = jcol - first ;
if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
nentUJK = nJ*ncolUJK ;
} else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
if ( count == 0 ) {
goto no_entries ;
}
nentUJK = count ;
}
nbytes = SubMtx_nbytesNeeded(mtxUJ->type, mtxUJ->mode,
nJ, ncolUJK, nentUJK) ;
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n ncolUJK %d, nentUJK %d, nbytes %d",
ncolUJK, nentUJK, nbytes) ;
fflush(msgFile) ;
}
mtxUJK = SubMtxManager_newObjectOfSizeNbytes(manager,
nbytes) ;
SubMtx_init(mtxUJK, mtxUJ->type, mtxUJ->mode, J, K,
nJ, ncolUJK, nentUJK) ;
if ( SUBMTX_IS_DENSE_COLUMNS(mtxUJ) ) {
SubMtx_denseInfo(mtxUJK,
&nrowUJK, &ncolUJK, &inc1, &inc2, &entUJK) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentUJK, entUJK, entUJ + first*nJ) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentUJK, entUJK, entUJ + 2*first*nJ) ;
}
} else if ( SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
SubMtx_sparseColumnsInfo(mtxUJK, &ncolUJK, &nentUJK,
&sizesUJK, &indicesUJK, &entUJK) ;
IVcopy(ncolUJK, sizesUJK, sizesUJ + first) ;
IVcopy(nentUJK, indicesUJK, indicesUJ + offset) ;
if ( FRONTMTX_IS_REAL(frontmtx) ) {
DVcopy(nentUJK, entUJK, entUJ + offset) ;
} else if ( FRONTMTX_IS_COMPLEX(frontmtx) ) {
DVcopy(2*nentUJK, entUJK, entUJ + 2*offset) ;
}
count = 0 ;
offset += nentUJK ;
}
/*
-------------------------------------
initialize the row and column indices
-------------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile, "\n setting row and column indices");
fflush(msgFile) ;
}
SubMtx_rowIndices(mtxUJK, &nrowUJK, &rowindUJK) ;
IVramp(nJ, rowindUJK, 0, 1) ;
SubMtx_columnIndices(mtxUJK, &ncolUJK, &colindUJK) ;
for ( ii = 0, jj = first ; ii < ncolUJK ; ii++, jj++ ) {
colindUJK[ii] = locmap[colindUJ[jj]] ;
}
/*
----------------------------------
insert U_{J,K} into the hash table
----------------------------------
*/
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n\n ## inserting U(%d,%d) ", J, K) ;
SubMtx_writeForHumanEye(mtxUJK, msgFile) ;
fflush(msgFile) ;
}
I2Ohash_insert(upperhash, J, K, (void *) mtxUJK) ;
/*
-----------------------------------
we jump to here if there were no
entries to be stored in the matrix.
-----------------------------------
*/
no_entries :
/*
----------------------------------------------------
reset first and K to new first location and front id
----------------------------------------------------
*/
first = jcol ;
if ( jcol < ncolUJ ) {
K = colmap[colindUJ[jcol]] ;
}
}
if ( jcol < ncolUJ && SUBMTX_IS_SPARSE_COLUMNS(mtxUJ) ) {
count += sizesUJ[jcol] ;
}
}
/*
--------------------------------------------
give U_{J,bnd{J}} back to the matrix manager
--------------------------------------------
*/
SubMtxManager_releaseObject(manager, mtxUJ) ;
}
}
}
/*
------------------------
free the working storage
------------------------
*/
IVfree(colmap) ;
IVfree(locmap) ;
return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
------------------------------------
test the Chv_assembleChv() method.
created -- 98apr18, cca
------------------------------------
*/
{
Chv *chvI, *chvJ ;
double imag, real, t1, t2 ;
double *entriesI, *entriesJ ;
Drand *drand ;
FILE *msgFile ;
int ierr, ii, irow, jcol,
lastcol, msglvl, ncolI, ncolJ, nDI, nDJ, nentI, nentJ,
nrowI, nrowJ, nUI, nUJ, seed, symflag, type ;
int *colindI, *colindJ, *rowindI, *rowindJ, *temp ;
if ( argc != 10 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nDJ nUJ nDI nUI type symflag seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n nDJ -- # of rows and columns in the (1,1) block"
"\n nUJ -- # of columns in the (1,2) block"
"\n nDI -- # of rows and columns in the (1,1) block"
"\n nUI -- # 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", 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) ;
}
nDJ = atoi(argv[3]) ;
nUJ = atoi(argv[4]) ;
nDI = atoi(argv[5]) ;
nUI = atoi(argv[6]) ;
type = atoi(argv[7]) ;
symflag = atoi(argv[8]) ;
seed = atoi(argv[9]) ;
if ( nDJ <= 0 || nUJ < 0
|| nDI <= 0 || nUI < 0
|| nDI >= nDJ || (nDI + nUI) >= (nDJ + nUJ)
|| nUI >= (nDJ + nUJ - nDI)
|| ( symflag != SPOOLES_SYMMETRIC
&& symflag != SPOOLES_HERMITIAN
&& symflag != SPOOLES_NONSYMMETRIC) ) {
fprintf(stderr, "\n invalid input"
"\n nDJ = %d, nUJ = %d, nDI = %d, nUI = %d, symflag = %d\n",
nDJ, nUJ, nDI, nUI, symflag) ;
exit(-1) ;
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setUniform(drand, -1.0, 1.0) ;
/*
----------------------------
initialize the ChvJ object
----------------------------
*/
MARKTIME(t1) ;
chvJ = Chv_new() ;
Chv_init(chvJ, 0, nDJ, nUJ, nUJ, type, symflag) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chv object",
t2 - t1) ;
fflush(msgFile) ;
Chv_columnIndices(chvJ, &ncolJ, &colindJ) ;
temp = IVinit(2*(nDJ+nUJ), -1) ;
IVramp(2*(nDJ+nUJ), temp, 0, 1) ;
IVshuffle(2*(nDJ+nUJ), temp, ++seed) ;
IVcopy(ncolJ, colindJ, temp) ;
IVfree(temp) ;
IVqsortUp(ncolJ, colindJ) ;
if ( CHV_IS_NONSYMMETRIC(chvJ) ) {
Chv_rowIndices(chvJ, &nrowJ, &rowindJ) ;
IVcopy(nrowJ, rowindJ, colindJ) ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %% column indices") ;
IVfprintf(msgFile, ncolJ, colindJ) ;
}
lastcol = colindJ[ncolJ-1] ;
nentJ = Chv_nent(chvJ) ;
entriesJ = Chv_entries(chvJ) ;
if ( CHV_IS_REAL(chvJ) ) {
Drand_fillDvector(drand, nentJ, entriesJ) ;
} else if ( CHV_IS_COMPLEX(chvJ) ) {
Drand_fillDvector(drand, 2*nentJ, entriesJ) ;
}
if ( CHV_IS_HERMITIAN(chvJ) ) {
/*
---------------------------------------------------------
hermitian example, set imaginary part of diagonal to zero
---------------------------------------------------------
*/
for ( irow = 0 ; irow < nDJ ; irow++ ) {
Chv_complexEntry(chvJ, irow, irow, &real, &imag) ;
Chv_setComplexEntry(chvJ, irow, irow, real, 0.0) ;
}
}
/*
---------------------------
initialize the ChvI object
---------------------------
*/
chvI = Chv_new() ;
Chv_init(chvI, 0, nDI, nUI, nUI, type, symflag) ;
Chv_columnIndices(chvI, &ncolI, &colindI) ;
temp = IVinit(ncolJ, -1) ;
IVramp(ncolJ, temp, 0, 1) ;
while ( 1 ) {
IVshuffle(ncolJ, temp, ++seed) ;
IVqsortUp(ncolI, temp) ;
if ( temp[0] < nDJ ) {
break ;
}
}
for ( ii = 0 ; ii < ncolI ; ii++ ) {
colindI[ii] = colindJ[temp[ii]] ;
}
IVfree(temp) ;
if ( CHV_IS_NONSYMMETRIC(chvI) ) {
Chv_rowIndices(chvI, &nrowI, &rowindI) ;
IVcopy(nrowI, rowindI, colindI) ;
}
nentI = Chv_nent(chvI) ;
entriesI = Chv_entries(chvI) ;
if ( CHV_IS_REAL(chvI) ) {
Drand_fillDvector(drand, nentI, entriesI) ;
} else if ( CHV_IS_COMPLEX(chvI) ) {
Drand_fillDvector(drand, 2*nentI, entriesI) ;
}
if ( CHV_IS_HERMITIAN(chvI) ) {
/*
---------------------------------------------------------
hermitian example, set imaginary part of diagonal to zero
---------------------------------------------------------
*/
for ( irow = 0 ; irow < nDI ; irow++ ) {
Chv_complexEntry(chvI, irow, irow, &real, &imag) ;
Chv_setComplexEntry(chvI, irow, irow, real, 0.0) ;
}
}
/*
--------------------------------------------------
write out the two chevron objects to a matlab file
--------------------------------------------------
*/
if ( msglvl > 1 ) {
fprintf(msgFile, "\n a = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chvJ, "a", msgFile) ;
fprintf(msgFile, "\n b = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chvI, "b", msgFile) ;
}
/*
---------------------------------------------
assemble the chvI object into the chvJ object
---------------------------------------------
*/
Chv_assembleChv(chvJ, chvI) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n %% after assembly") ;
fprintf(msgFile, "\n c = zeros(%d,%d) ;", lastcol+1, lastcol+1) ;
Chv_writeForMatlab(chvJ, "c", msgFile) ;
}
/*
-----------------
compute the error
-----------------
*/
fprintf(msgFile, "\n max(max(abs(c - (b + a))))") ;
/*
------------------------
free the working storage
------------------------
*/
Chv_free(chvJ) ;
Chv_free(chvI) ;
Drand_free(drand) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*
----------------------------
purpose -- basic initializer
created -- 98may01, cca
----------------------------
*/
void
SubMtx_init (
SubMtx *mtx,
int type,
int mode,
int rowid,
int colid,
int nrow,
int ncol,
int nent
) {
int nbytes ;
int *colind, *rowind ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in SubMtx_init()"
"\n mtx is NULL\n") ;
exit(-1) ;
}
if ( nrow <= 0 ) {
fprintf(stderr, "\n fatal error in SubMtx_init()"
"\n nrow = %d <= 0\n", nrow) ;
exit(-1) ;
}
if ( ncol <= 0 ) {
fprintf(stderr, "\n fatal error in SubMtx_init()"
"\n ncol = %d <= 0\n", ncol) ;
exit(-1) ;
}
if ( nrow <= 0 ) {
fprintf(stderr, "\n fatal error in SubMtx_init()"
"\n nent = %d <= 0\n", nent) ;
exit(-1) ;
}
switch ( type ) {
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
break ;
default :
fprintf(stderr, "\n fatal error in SubMtx_init()"
"\n invalid type %d", type) ;
exit(-1) ;
}
switch ( mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS :
case SUBMTX_DIAGONAL :
case SUBMTX_SPARSE_ROWS :
case SUBMTX_SPARSE_COLUMNS :
case SUBMTX_SPARSE_TRIPLES :
case SUBMTX_DENSE_SUBROWS :
case SUBMTX_DENSE_SUBCOLUMNS :
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM :
break ;
default :
fprintf(stderr, "\n fatal error in SubMtx_init()"
"\n invalid mode %d", mode) ;
exit(-1) ;
}
/*
-------------------------------------------------------
get and set the number of bytes needed in the workspace
-------------------------------------------------------
*/
nbytes = SubMtx_nbytesNeeded(type, mode, nrow, ncol, nent) ;
SubMtx_setNbytesInWorkspace(mtx, nbytes) ;
DVzero(nbytes/sizeof(double), (double *) SubMtx_workspace(mtx)) ;
/*
--------------
set the fields
--------------
*/
SubMtx_setFields(mtx, type, mode, rowid, colid, nrow, ncol, nent) ;
SubMtx_rowIndices(mtx, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVramp(ncol, colind, 0, 1) ;
return ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------
test the Chv_update{H,S,N}() methods.
T := T - U^T * D * U
T := T - U^H * D * U
T := T - L * D * U
created -- 98apr23, cca
-------------------------------------
*/
{
Chv *chvT ;
SubMtx *mtxD, *mtxL, *mtxU ;
double imag, ops, real, t1, t2 ;
Drand *drand ;
DV *tempDV ;
FILE *msgFile ;
int irow, msglvl, ncolT, nDT, ncolU, nentT, nentU, nrowD,
nrowL, nrowT, offset, seed, size, sparsityflag, symflag, type ;
int *colindT, *colindU, *ivec, *rowindL, *rowindT ;
if ( argc != 13 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type symflag sparsityflag"
"\n ncolT ncolU nrowD nentU offset seed"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- entries type"
"\n 1 -- real"
"\n 2 -- complex"
"\n symflag -- type of matrix U"
"\n 0 -- symmetric"
"\n 1 -- hermitian"
"\n 2 -- nonsymmetric"
"\n sparsityflag -- dense or sparse"
"\n 0 -- dense"
"\n 1 -- sparse"
"\n ncolT -- # of rows and columns in matrix T"
"\n nDT -- # of internal rows and columns in matrix T"
"\n ncolU -- # of rows and columns in matrix U"
"\n nrowD -- # of rows and columns in matrix D"
"\n nentU -- # of entries in matrix U"
"\n offset -- distance between D_I and T"
"\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") ;
spoolesFatal();
}
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) ;
}
type = atoi(argv[3]) ;
symflag = atoi(argv[4]) ;
sparsityflag = atoi(argv[5]) ;
ncolT = atoi(argv[6]) ;
nDT = atoi(argv[7]) ;
ncolU = atoi(argv[8]) ;
nrowD = atoi(argv[9]) ;
nentU = atoi(argv[10]) ;
offset = atoi(argv[11]) ;
seed = atoi(argv[12]) ;
fprintf(msgFile, "\n %% %s:"
"\n %% msglvl = %d"
"\n %% msgFile = %s"
"\n %% type = %d"
"\n %% symflag = %d"
"\n %% sparsityflag = %d"
"\n %% ncolT = %d"
"\n %% nDT = %d"
"\n %% ncolU = %d"
"\n %% nrowD = %d"
"\n %% nentU = %d"
"\n %% offset = %d"
"\n %% seed = %d",
argv[0], msglvl, argv[2], type, symflag, sparsityflag,
ncolT, nDT, ncolU, nrowD, nentU, offset, seed) ;
/*
-----------------------------
check for errors in the input
-----------------------------
*/
if ( (type != SPOOLES_REAL
&& type != SPOOLES_COMPLEX)
|| (symflag != SPOOLES_SYMMETRIC
&& symflag != SPOOLES_HERMITIAN
&& symflag != SPOOLES_NONSYMMETRIC)
|| (sparsityflag < 0 || sparsityflag > 1)
|| ncolT <= 0 || ncolU > (ncolT + offset) || nrowD <= 0 ) {
fprintf(stderr, "\n invalid input\n") ;
spoolesFatal();
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, ++seed) ;
Drand_setNormal(drand, 0.0, 1.0) ;
/*
-----------------------
get a vector of indices
-----------------------
*/
size = nrowD + offset + ncolT ;
ivec = IVinit(size, -1) ;
IVramp(size, ivec, 0, 1) ;
/*
----------------------------
initialize the T Chv object
----------------------------
*/
fprintf(msgFile, "\n\n %% symflag = %d", symflag) ;
MARKTIME(t1) ;
chvT = Chv_new() ;
Chv_init(chvT, 0, nDT, ncolT - nDT, ncolT - nDT, type, symflag) ;
nentT = Chv_nent(chvT) ;
if ( CHV_IS_REAL(chvT) ) {
Drand_fillDvector(drand, nentT, Chv_entries(chvT)) ;
} else if ( CHV_IS_COMPLEX(chvT) ) {
Drand_fillDvector(drand, 2*nentT, Chv_entries(chvT)) ;
}
Chv_columnIndices(chvT, &ncolT, &colindT) ;
IVcopy(ncolT, colindT, ivec + nrowD + offset) ;
if ( CHV_IS_NONSYMMETRIC(chvT) ) {
Chv_rowIndices(chvT, &nrowT, &rowindT) ;
IVcopy(nrowT, rowindT, colindT) ;
}
IVfree(ivec) ;
if ( CHV_IS_HERMITIAN(chvT) ) {
fprintf(msgFile, "\n\n %% hermitian\n") ;
/*
---------------------------------------------------------
hermitian example, set imaginary part of diagonal to zero
---------------------------------------------------------
*/
for ( irow = 0 ; irow < nDT ; irow++ ) {
Chv_complexEntry(chvT, irow, irow, &real, &imag) ;
Chv_setComplexEntry(chvT, irow, irow, real, 0.0) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize chvT Chv object",
t2 - t1) ;
fprintf(msgFile, "\n T = zeros(%d,%d); ", size, size) ;
Chv_writeForMatlab(chvT, "T", msgFile) ;
/*
---------------------------
initialize the D Mtx object
---------------------------
*/
MARKTIME(t1) ;
mtxD = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
if ( CHV_IS_SYMMETRIC(chvT) ) {
SubMtx_initRandom(mtxD, SPOOLES_REAL, SUBMTX_BLOCK_DIAGONAL_SYM,
0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
} else {
SubMtx_initRandom(mtxD, SPOOLES_REAL, SUBMTX_DIAGONAL,
0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
}
} else if ( CHV_IS_COMPLEX(chvT) ) {
if ( CHV_IS_HERMITIAN(chvT) ) {
SubMtx_initRandom(mtxD,SPOOLES_COMPLEX,SUBMTX_BLOCK_DIAGONAL_HERM,
0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
} else if ( CHV_IS_SYMMETRIC(chvT) ) {
SubMtx_initRandom(mtxD,SPOOLES_COMPLEX, SUBMTX_BLOCK_DIAGONAL_SYM,
0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
} else {
SubMtx_initRandom(mtxD, SPOOLES_COMPLEX, SUBMTX_DIAGONAL,
0, 0, nrowD, nrowD, nrowD*nrowD, ++seed) ;
}
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize D SubMtx object",
t2 - t1) ;
fprintf(msgFile, "\n D = zeros(%d,%d) ;", nrowD, nrowD) ;
SubMtx_writeForMatlab(mtxD, "D", msgFile) ;
/*
----------------------------
initialize the U SubMtx object
----------------------------
*/
MARKTIME(t1) ;
mtxU = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
if ( sparsityflag == 0 ) {
SubMtx_initRandom(mtxU, SPOOLES_REAL, SUBMTX_DENSE_COLUMNS,
0, 0, nrowD, ncolU, nentU, ++seed) ;
} else {
SubMtx_initRandom(mtxU, SPOOLES_REAL, SUBMTX_SPARSE_COLUMNS,
0, 0, nrowD, ncolU, nentU, ++seed) ;
}
} else if ( CHV_IS_COMPLEX(chvT) ) {
if ( sparsityflag == 0 ) {
SubMtx_initRandom(mtxU, SPOOLES_COMPLEX, SUBMTX_DENSE_COLUMNS,
0, 0, nrowD, ncolU, nentU, ++seed) ;
} else {
SubMtx_initRandom(mtxU, SPOOLES_COMPLEX, SUBMTX_SPARSE_COLUMNS,
0, 0, nrowD, ncolU, nentU, ++seed) ;
}
}
ivec = IVinit(offset + ncolT, -1) ;
IVramp(offset + ncolT, ivec, nrowD, 1) ;
IVshuffle(offset + ncolT, ivec, ++seed) ;
SubMtx_columnIndices(mtxU, &ncolU, &colindU) ;
IVcopy(ncolU, colindU, ivec) ;
IVqsortUp(ncolU, colindU) ;
IVfree(ivec) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize U SubMtx object",
t2 - t1) ;
fprintf(msgFile, "\n U = zeros(%d,%d) ;", nrowD, size) ;
SubMtx_writeForMatlab(mtxU, "U", msgFile) ;
if ( CHV_IS_NONSYMMETRIC(chvT) ) {
/*
----------------------------
initialize the L SubMtx object
----------------------------
*/
MARKTIME(t1) ;
mtxL = SubMtx_new() ;
if ( CHV_IS_REAL(chvT) ) {
if ( sparsityflag == 0 ) {
SubMtx_initRandom(mtxL, SPOOLES_REAL, SUBMTX_DENSE_ROWS,
0, 0, ncolU, nrowD, nentU, ++seed) ;
} else {
SubMtx_initRandom(mtxL, SPOOLES_REAL, SUBMTX_SPARSE_ROWS,
0, 0, ncolU, nrowD, nentU, ++seed) ;
}
} else if ( CHV_IS_COMPLEX(chvT) ) {
if ( sparsityflag == 0 ) {
SubMtx_initRandom(mtxL, SPOOLES_COMPLEX, SUBMTX_DENSE_ROWS,
0, 0, ncolU, nrowD, nentU, ++seed) ;
} else {
SubMtx_initRandom(mtxL, SPOOLES_COMPLEX, SUBMTX_SPARSE_ROWS,
0, 0, ncolU, nrowD, nentU, ++seed) ;
}
}
SubMtx_rowIndices(mtxL, &nrowL, &rowindL) ;
IVcopy(nrowL, rowindL, colindU) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize L SubMtx object",
t2 - t1) ;
fprintf(msgFile, "\n L = zeros(%d,%d) ;", size, nrowD) ;
SubMtx_writeForMatlab(mtxL, "L", msgFile) ;
} else {
mtxL = NULL ;
}
/*
--------------------------------
compute the matrix-matrix update
--------------------------------
*/
tempDV = DV_new() ;
ops = 8*nrowD*nrowD*ncolU ;
if ( CHV_IS_SYMMETRIC(chvT) ) {
Chv_updateS(chvT, mtxD, mtxU, tempDV) ;
} else if ( CHV_IS_HERMITIAN(chvT) ) {
Chv_updateH(chvT, mtxD, mtxU, tempDV) ;
} else if ( CHV_IS_NONSYMMETRIC(chvT) ) {
Chv_updateN(chvT, mtxL, mtxD, mtxU, tempDV) ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to compute m-m, %.3f mflops",
t2 - t1, ops*1.e-6/(t2 - t1)) ;
if ( msglvl > 1 ) {
fprintf(msgFile, "\n\n %% Z Chv object") ;
fprintf(msgFile, "\n Z = zeros(%d,%d); ", size, size) ;
Chv_writeForMatlab(chvT, "Z", msgFile) ;
fflush(msgFile) ;
}
/*
-----------------
check with matlab
-----------------
*/
if ( msglvl > 1 ) {
if ( CHV_IS_HERMITIAN(chvT) ) {
fprintf(msgFile, "\n\n B = ctranspose(U) * D * U ;") ;
} else if ( CHV_IS_SYMMETRIC(chvT) ) {
fprintf(msgFile, "\n\n B = transpose(U) * D * U ;") ;
} else {
fprintf(msgFile, "\n\n B = L * D * U ;") ;
}
fprintf(msgFile,
"\n\n for irow = 1:%d"
"\n for jcol = 1:%d"
"\n if T(irow,jcol) ~= 0.0"
"\n T(irow,jcol) = T(irow,jcol) - B(irow,jcol) ;"
"\n end"
"\n end"
"\n end"
"\n emtx = abs(Z - T) ;",
size, size) ;
fprintf(msgFile, "\n\n maxabs = max(max(emtx)) ") ;
fflush(msgFile) ;
}
/*
------------------------
free the working storage
------------------------
*/
if ( mtxL != NULL ) {
SubMtx_free(mtxL) ;
}
Chv_free(chvT) ;
SubMtx_free(mtxD) ;
SubMtx_free(mtxU) ;
DV_free(tempDV) ;
Drand_free(drand) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*
--------------------------------------------------------------
purpose -- create and return an A2 object that contains rows
of A and rows from update matrices of the children.
the matrix may not be in staircase form
created -- 98may25, cca
--------------------------------------------------------------
*/
A2 *
FrontMtx_QR_assembleFront (
FrontMtx *frontmtx,
int J,
InpMtx *mtxA,
IVL *rowsIVL,
int firstnz[],
int colmap[],
Chv *firstchild,
DV *workDV,
int msglvl,
FILE *msgFile
) {
A2 *frontJ ;
Chv *chvI ;
double *rowI, *rowJ, *rowentA ;
int ii, irow, irowA, irowI, jcol, jj, jrow, ncolI, ncolJ,
nentA, nrowI, nrowJ, nrowFromA ;
int *colindA, *colindI, *colindJ, *map, *rowids, *rowsFromA ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || mtxA == NULL || rowsIVL == NULL
|| (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr, "\n fatal error in FrontMtx_QR_assembleFront()"
"\n bad input\n") ;
exit(-1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n inside FrontMtx_QR_assembleFront(%d)", J) ;
fflush(msgFile) ;
}
/*
--------------------------------------------------
set up the map from global to local column indices
--------------------------------------------------
*/
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
for ( jcol = 0 ; jcol < ncolJ ; jcol++ ) {
colmap[colindJ[jcol]] = jcol ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n front %d's column indices", J) ;
IVfprintf(msgFile, ncolJ, colindJ) ;
fflush(msgFile) ;
}
/*
-------------------------------------------------
compute the size of the front and map the global
indices of the update matrices into local indices
-------------------------------------------------
*/
IVL_listAndSize(rowsIVL, J, &nrowFromA, &rowsFromA) ;
nrowJ = nrowFromA ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %d rows from A", nrowFromA) ;
fflush(msgFile) ;
}
for ( chvI = firstchild ; chvI != NULL ; chvI = chvI->next ) {
nrowJ += chvI->nD ;
Chv_columnIndices(chvI, &ncolI, &colindI) ;
for ( jcol = 0 ; jcol < ncolI ; jcol++ ) {
colindI[jcol] = colmap[colindI[jcol]] ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %d rows from child %d", chvI->nD, chvI->id) ;
fflush(msgFile) ;
}
}
/*
----------------------------------------------------------
get workspace for the rowids[nrowJ] and map[nrowJ] vectors
----------------------------------------------------------
*/
if ( sizeof(int) == sizeof(double) ) {
DV_setSize(workDV, 2*nrowJ) ;
} else if ( 2*sizeof(int) == sizeof(double) ) {
DV_setSize(workDV, nrowJ) ;
}
rowids = (int *) DV_entries(workDV) ;
map = rowids + nrowJ ;
IVramp(nrowJ, rowids, 0, 1) ;
IVfill(nrowJ, map, -1) ;
/*
-----------------------------------------------------------------
get the map from incoming rows to their place in the front matrix
-----------------------------------------------------------------
*/
for ( irow = jrow = 0 ; irow < nrowFromA ; irow++, jrow++ ) {
irowA = rowsFromA[irow] ;
map[jrow] = colmap[firstnz[irowA]] ;
}
for ( chvI = firstchild ; chvI != NULL ; chvI = chvI->next ) {
nrowI = chvI->nD ;
Chv_columnIndices(chvI, &ncolI, &colindI) ;
for ( irow = 0 ; irow < nrowI ; irow++, jrow++ ) {
map[jrow] = colindI[irow] ;
}
}
IV2qsortUp(nrowJ, map, rowids) ;
for ( irow = 0 ; irow < nrowJ ; irow++ ) {
map[rowids[irow]] = irow ;
}
/*
----------------------------
allocate the A2 front object
----------------------------
*/
frontJ = A2_new() ;
A2_init(frontJ, frontmtx->type, nrowJ, ncolJ, ncolJ, 1, NULL) ;
A2_zero(frontJ) ;
/*
------------------------------------
load the original rows of the matrix
------------------------------------
*/
for ( jrow = 0 ; jrow < nrowFromA ; jrow++ ) {
irowA = rowsFromA[jrow] ;
rowJ = A2_row(frontJ, map[jrow]) ;
if ( A2_IS_REAL(frontJ) ) {
InpMtx_realVector(mtxA, irowA, &nentA, &colindA, &rowentA) ;
} else if ( A2_IS_COMPLEX(frontJ) ) {
InpMtx_complexVector(mtxA, irowA, &nentA, &colindA, &rowentA) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n loading row %d", irowA) ;
fprintf(msgFile, "\n global indices") ;
IVfprintf(msgFile, nentA, colindA) ;
fflush(msgFile) ;
}
if ( A2_IS_REAL(frontJ) ) {
for ( ii = 0 ; ii < nentA ; ii++ ) {
jj = colmap[colindA[ii]] ;
rowJ[jj] = rowentA[ii] ;
}
} else if ( A2_IS_COMPLEX(frontJ) ) {
for ( ii = 0 ; ii < nentA ; ii++ ) {
jj = colmap[colindA[ii]] ;
rowJ[2*jj] = rowentA[2*ii] ;
rowJ[2*jj+1] = rowentA[2*ii+1] ;
}
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n after assembling rows of A") ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
/*
----------------------------------
load the updates from the children
----------------------------------
*/
for ( chvI = firstchild ; chvI != NULL ; chvI = chvI->next ) {
nrowI = chvI->nD ;
Chv_columnIndices(chvI, &ncolI, &colindI) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n loading child %d", chvI->id) ;
fprintf(msgFile, "\n child's column indices") ;
IVfprintf(msgFile, ncolI, colindI) ;
Chv_writeForHumanEye(chvI, msgFile) ;
fflush(msgFile) ;
}
rowI = Chv_entries(chvI) ;
for ( irowI = 0 ; irowI < nrowI ; irowI++, jrow++ ) {
rowJ = A2_row(frontJ, map[jrow]) ;
if ( A2_IS_REAL(frontJ) ) {
for ( ii = irowI ; ii < ncolI ; ii++ ) {
jj = colindI[ii] ;
rowJ[jj] = rowI[ii] ;
}
rowI += ncolI - irowI - 1 ;
} else if ( A2_IS_COMPLEX(frontJ) ) {
for ( ii = irowI ; ii < ncolI ; ii++ ) {
jj = colindI[ii] ;
rowJ[2*jj] = rowI[2*ii] ;
rowJ[2*jj+1] = rowI[2*ii+1] ;
}
rowI += 2*(ncolI - irowI - 1) ;
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n after assembling child %d", chvI->id) ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
}
return(frontJ) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
---------------------------------------------------
test the Chv_findPivot(), swap and update methods.
the program's output is a matlab file
to check correctness of the code.
created -- 98jan24, cca
---------------------------------------------------
*/
{
Chv *chv ;
double imag, real, tau, t1, t2 ;
double *entries ;
Drand *drand ;
DV *workDV ;
FILE *msgFile ;
int icol, ii, ipvt, irow, jcol, jpvt, jrow, msglvl, ncol, nD,
ndelay, nent, nL, nrow, ntest, nU, rc, pivotsize, seed,
symflag, tag, temp, type ;
int *colind, *rowind ;
if ( argc != 9 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nD nU type symflag seed tau "
"\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 tau -- bound on magnitudes of factor entries"
"\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]) ;
tau = atof(argv[8]) ;
fprintf(msgFile, "\n %% testChv:"
"\n %% msglvl = %d"
"\n %% msgFile = %s"
"\n %% nD = %d"
"\n %% nU = %d"
"\n %% type = %d"
"\n %% symflag = %d"
"\n %% seed = %d"
"\n %% tau = %12.4e",
msglvl, argv[2], nD, nU, type, symflag, seed, tau) ;
nL = nU ;
nrow = nD + nL ;
ncol = nD + nU ;
/*
-----------------------------
check for errors in the input
-----------------------------
*/
if ( nD <= 0 || nU < 0
|| (symflag != SPOOLES_SYMMETRIC
&& symflag != SPOOLES_HERMITIAN
&& symflag != SPOOLES_NONSYMMETRIC) ) {
fprintf(stderr, "\n invalid input"
"\n nD = %d, nL = %d, nU = %d, symflag = %d\n",
nD, nL, nU, symflag) ;
exit(-1) ;
}
if ( (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
&& nL != nU ) {
fprintf(stderr, "\n invalid input"
"\n symflag = %d, nL = %d, nU = %d", symflag, nL, nU) ;
exit(-1) ;
}
fprintf(msgFile,
"\n nD = %d ;"
"\n nL = %d ;"
"\n nU = %d ;"
"\n nrow = nD + nL ;"
"\n ncol = nD + nU ;",
nD, nL, nU) ;
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.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) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
Chv_rowIndices(chv, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
/*
------------------------------------
load the entries with random entries
------------------------------------
*/
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 ( msglvl > 4 ) {
fprintf(msgFile, "\n raw entries vector") ;
DVfprintf(msgFile, 2*nent, entries) ;
fflush(msgFile) ;
}
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) ;
}
}
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "a", msgFile) ;
/*
------------
find a pivot
------------
*/
workDV = DV_new() ;
ndelay = 0 ;
ntest = 0 ;
pivotsize = Chv_findPivot(chv, workDV, tau, ndelay,
&irow, &jcol, &ntest) ;
fprintf(msgFile, "\n\n %% pivotsize = %d", pivotsize) ;
ipvt = irow ;
jpvt = jcol ;
if ( (symflag == SPOOLES_SYMMETRIC || symflag == SPOOLES_HERMITIAN)
&& irow > jcol ) {
temp = irow ;
irow = jcol ;
jcol = temp ;
}
fprintf(msgFile, "\n\n irow = %d ; \n jcol = %d ;", irow+1, jcol+1) ;
/*
-------------------------
swap the rows and columns
-------------------------
*/
if ( pivotsize == 0 ) {
exit(0) ;
} else if ( pivotsize == 1 ) {
fprintf(msgFile,
"\n b = a ;"
"\n xtemp = b(irow,:) ;"
"\n b(irow,:) = b(1,:) ;"
"\n b(1,:) = xtemp ;"
"\n xtemp = b(:,jcol) ;"
"\n b(:,jcol) = b(:,1) ;"
"\n b(:,1) = xtemp ;") ;
if ( CHV_IS_SYMMETRIC(chv) || symflag == CHV_IS_HERMITIAN(chv) ) {
Chv_swapRowsAndColumns(chv, 0, irow) ;
} else {
Chv_swapRows(chv, 0, irow) ;
Chv_swapColumns(chv, 0, jcol) ;
}
} else if ( pivotsize == 2 ) {
if ( symflag < 2 ) {
fprintf(msgFile,
"\n b = a ;"
"\n xtemp = b(irow,:) ;"
"\n b(irow,:) = b(1,:) ;"
"\n b(1,:) = xtemp ;"
"\n xtemp = b(:,irow) ;"
"\n b(:,irow) = b(:,1) ;"
"\n b(:,1) = xtemp ;"
"\n xtemp = b(jcol,:) ;"
"\n b(jcol,:) = b(2,:) ;"
"\n b(2,:) = xtemp ;"
"\n xtemp = b(:,jcol) ;"
"\n b(:,jcol) = b(:,2) ;"
"\n b(:,2) = xtemp ;") ;
Chv_swapRowsAndColumns(chv, 0, irow) ;
Chv_swapRowsAndColumns(chv, 1, jcol) ;
} else {
fprintf(stderr, "\n fatal error, symflag = %d, pvtsize = %d",
symflag, pivotsize) ;
exit(-1) ;
}
}
/*
-----------------------------------------
check that the swap was executed properly
-----------------------------------------
*/
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "c", msgFile) ;
fprintf(msgFile, "\n maxerrswap = norm(c - a)") ;
/*
---------------------------
ramp the indices once again
---------------------------
*/
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
Chv_rowIndices(chv, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
/*
-----------------------------------
perform the rank-1 or rank-2 update
-----------------------------------
*/
fprintf(msgFile, "\n\n ckeep = b ;") ;
fprintf(msgFile, "\n\n c = b ;") ;
if ( pivotsize == 1 ) {
rc = Chv_r1upd(chv) ;
fprintf(msgFile,
"\n\n d = c(1,1) ;"
"\n l = c(2:nrow,1)/d ;"
"\n u = c(1,2:ncol) ;") ;
if ( nD > 1 ) {
fprintf(msgFile,
"\n c(2:nrow,2:ncol) = c(2:nrow,2:ncol) - l*u ;") ;
}
fprintf(msgFile,
"\n u = u / d ;"
"\n c(1:1,1:1) = d ; "
"\n c(1:1,2:ncol) = u ; "
"\n c(2:ncol,1:1) = l ; ") ;
fprintf(msgFile, "\n c(nD+1:nrow,nD+1:ncol) = 0 ;") ;
} else {
rc = Chv_r2upd(chv) ;
fprintf(msgFile,
"\n\n d = c(1:2,1:2) ;"
"\n l = c(3:nrow,1:2) / d ;"
"\n u = c(1:2,3:ncol) ;") ;
if ( nD > 2 ) {
fprintf(msgFile,
"\n c(3:nrow,3:ncol) = c(3:nrow,3:ncol) - l*u ;") ;
}
fprintf(msgFile,
"\n u = d \\ u ; "
"\n c(1:2,1:2) = d ; "
"\n c(1:2,3:ncol) = u ; "
"\n c(3:ncol,1:2) = l ; ") ;
if ( nU > 0 ) {
fprintf(msgFile,
"\n c(nD+1:nrow,nD+1:ncol) = 0 ;") ;
}
}
fprintf(msgFile, "\n %% matrix entries after update") ;
Chv_writeForMatlab(chv, "f", msgFile) ;
fprintf(msgFile, "\n maxerrupd = norm(f - c)") ;
/*
------------------------------------------------------
check out the maximum magnitude of elements in l and u
------------------------------------------------------
*/
fprintf(msgFile, "\n ipvt = %d", ipvt + 1) ;
fprintf(msgFile, "\n jpvt = %d", jpvt + 1) ;
fprintf(msgFile, "\n pivotsize = %d", pivotsize) ;
fprintf(msgFile, "\n tau = %12.4e", tau) ;
if ( symflag < 2 ) {
fprintf(msgFile, "\n ubound = max(max(abs(u))) ") ;
} else {
fprintf(msgFile,
"\n lbound = max(max(abs(l))) "
"\n ubound = max(max(abs(u))) ") ;
}
/*
------------------------
free the working storage
------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
DV_free(workDV) ;
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) ; }
/*
----------------------------------------------
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) ; }
/*
-------------------------------------------------------
purpose -- merge the front tree allowing a parent
to absorb all children when that creates
at most maxzeros zero entries inside a front
return --
IV object that has the old front to new front map
created -- 98jan29, cca
-------------------------------------------------------
*/
ETree *
ETree_mergeFrontsAll (
ETree *etree,
int maxzeros,
IV *nzerosIV
) {
ETree *etree2 ;
int cost, J, Jall, K, KandBnd, nfront, nvtx, nnew ;
int *bndwghts, *fch, *map, *nodwghts, *nzeros, *rep, *sib, *temp ;
IV *mapIV ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL || nzerosIV == NULL
|| (nfront = etree->nfront) <= 0
|| (nvtx = etree->nvtx) <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)"
"\n bad input\n", etree, maxzeros, nzerosIV) ;
if ( etree != NULL ) {
fprintf(stderr, "\n nfront = %d, nvtx = %d",
etree->nfront, etree->nvtx) ;
}
spoolesFatal();
}
if ( IV_size(nzerosIV) != nfront ) {
fprintf(stderr, "\n fatal error in ETree_mergeFrontsAll(%p,%d,%p)"
"\n size(nzerosIV) = %d, nfront = %d\n",
etree, maxzeros, nzerosIV, IV_size(nzerosIV), nfront) ;
spoolesFatal();
}
nzeros = IV_entries(nzerosIV) ;
/*
----------------------
set up working storage
----------------------
*/
tree = etree->tree ;
fch = ETree_fch(etree) ;
sib = ETree_sib(etree) ;
nodwghts = IVinit(nfront, 0) ;
IVcopy(nfront, nodwghts, ETree_nodwghts(etree)) ;
bndwghts = ETree_bndwghts(etree) ;
rep = IVinit(nfront, -1) ;
IVramp(nfront, rep, 0, 1) ;
/*
------------------------------------------
perform a post-order traversal of the tree
------------------------------------------
*/
for ( K = Tree_postOTfirst(tree) ;
K != -1 ;
K = Tree_postOTnext(tree, K) ) {
#if MYDEBUG > 0
fprintf(stdout, "\n\n ##### visiting front %d", K) ;
fflush(stdout) ;
#endif
if ( (J = fch[K]) != -1 ) {
KandBnd = nodwghts[K] + bndwghts[K] ;
Jall = 0 ;
cost = 2*nzeros[K] ;
for ( J = fch[K] ; J != -1 ; J = sib[J] ) {
Jall += nodwghts[J] ;
cost -= nodwghts[J]*nodwghts[J] ;
cost += 2*nodwghts[J]*(KandBnd - bndwghts[J]) ;
cost += 2*nzeros[J] ;
}
cost += Jall*Jall ;
cost = cost/2 ;
#if MYDEBUG > 0
fprintf(stdout, "\n cost = %d", cost) ;
fflush(stdout) ;
#endif
if ( cost <= maxzeros ) {
for ( J = fch[K] ; J != -1 ; J = sib[J] ) {
#if MYDEBUG > 0
fprintf(stdout, "\n merging %d into %d", J, K) ;
fflush(stdout) ;
#endif
rep[J] = K ;
nodwghts[K] += nodwghts[J] ;
}
nzeros[K] = cost ;
}
}
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n whoa, finished") ;
fflush(stdout) ;
#endif
/*
-------------------------------------------------
take the map from fronts to representative fronts
and make the map from old fronts to new fronts
-------------------------------------------------
*/
mapIV = IV_new() ;
IV_init(mapIV, nfront, NULL) ;
map = IV_entries(mapIV) ;
for ( J = 0, nnew = 0 ; J < nfront ; J++ ) {
if ( rep[J] == J ) {
map[J] = nnew++ ;
} else {
K = J ;
while ( rep[K] != K ) {
K = rep[K] ;
}
rep[J] = K ;
}
}
for ( J = 0 ; J < nfront ; J++ ) {
if ( (K = rep[J]) != J ) {
map[J] = map[K] ;
}
}
/*
-------------------------------
get the compressed ETree object
-------------------------------
*/
etree2 = ETree_compress(etree, mapIV) ;
/*
-------------------------
remap the nzeros[] vector
-------------------------
*/
temp = IVinit(nfront, 0) ;
IVcopy(nfront, temp, nzeros) ;
IV_setSize(nzerosIV, nnew) ;
nzeros = IV_entries(nzerosIV) ;
for ( J = 0 ; J < nfront ; J++ ) {
if ( rep[J] == J ) {
nzeros[map[J]] = temp[J] ;
}
}
IVfree(temp) ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(nodwghts) ;
IVfree(rep) ;
IV_free(mapIV) ;
return(etree2) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-------------------------------------
test the Chv_r1upd() method.
the program's output is a matlab file
to check correctness of the code.
created -- 98apr30, cca
-------------------------------------
*/
{
Chv *chv ;
double imag, real, t1, t2 ;
double *entries ;
Drand *drand ;
FILE *msgFile ;
int ii, irow, jcol, msglvl, ncol, nD, nent, nL, nrow, nU,
rc, seed, symflag, tag, type ;
int *colind, *rowind ;
if ( argc != 8 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile nD nU type symflag 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 --> hermitian"
"\n 1 --> symmetric"
"\n 2 --> nonsymmetric "
"\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]) ;
seed = atoi(argv[7]) ;
fprintf(msgFile, "\n %% testChv:"
"\n %% msglvl = %d"
"\n %% msgFile = %s"
"\n %% nD = %d"
"\n %% nU = %d"
"\n %% type = %d"
"\n %% symflag = %d"
"\n %% seed = %d",
msglvl, argv[2], nD, nU, type, symflag, seed) ;
nL = nU ;
/*
-----------------------------
check for errors in the input
-----------------------------
*/
if ( nD <= 0 || nL < 0 || nU < 0
|| symflag < 0 || symflag > 3 ) {
fprintf(stderr, "\n invalid input"
"\n nD = %d, nL = %d, nU = %d, symflag = %d\n",
nD, nL, nU, symflag) ;
exit(-1) ;
}
if ( symflag <= 2 && nL != nU ) {
fprintf(stderr, "\n invalid input"
"\n symflag = %d, nL = %d, nU = %d", symflag, nL, nU) ;
exit(-1) ;
}
/*
--------------------------------------
initialize the random number generator
--------------------------------------
*/
drand = Drand_new() ;
Drand_init(drand) ;
Drand_setSeed(drand, seed) ;
Drand_setNormal(drand, 0.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) ;
IVramp(ncol, colind, 0, 1) ;
if ( CHV_IS_NONSYMMETRIC(chv) ) {
Chv_rowIndices(chv, &nrow, &rowind) ;
IVramp(nrow, rowind, 0, 1) ;
}
/*
------------------------------------
load the entries with random entries
------------------------------------
*/
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) ) {
for ( irow = 0 ; irow < nD ; irow++ ) {
Chv_complexEntry(chv, irow, irow, &real, &imag) ;
Chv_setComplexEntry(chv, irow, irow, real, 0.0) ;
}
}
fprintf(msgFile, "\n %% matrix entries") ;
Chv_writeForMatlab(chv, "a", msgFile) ;
/*
---------------------------------------
write out matlab code for rank-1 update
---------------------------------------
*/
fprintf(msgFile,
"\n nD = %d ;"
"\n nL = %d ;"
"\n nU = %d ;"
"\n nrow = nD + nL ;"
"\n ncol = nD + nU ;"
"\n b = a ; "
"\n d = a(1,1) ;"
"\n l = a(2:nrow,1) / d ; "
"\n u = a(1,2:ncol) ; "
"\n b(2:nrow,2:ncol) = a(2:nrow,2:ncol) - l * u ; "
"\n u = u / d ; "
"\n b(1,1) = d ; "
"\n b(1,2:ncol) = u ; "
"\n b(2:nrow,1) = l ; ",
nD, nL, nU) ;
if ( nL > 0 && nU > 0 ) {
fprintf(msgFile, "\n b(nD+1:nrow,nD+1:ncol) = 0.0 ;") ;
}
/*
-------------------------
perform the rank-1 update
-------------------------
*/
rc = Chv_r1upd(chv) ;
/*
fprintf(msgFile, "\n raw entries vector") ;
DVfprintf(msgFile, 2*nent, entries) ;
*/
fprintf(msgFile, "\n %% matrix entries after update") ;
Chv_writeForMatlab(chv, "c", msgFile) ;
fprintf(msgFile, "\n maxerr = max(max(abs(c-b)))") ;
/*
------------------------
free the working storage
------------------------
*/
Chv_free(chv) ;
Drand_free(drand) ;
fprintf(msgFile, "\n") ;
return(1) ; }
/*
------------------------------------------------
given a permutation and a vector to map vertices
into compressed vertices, create and return a
permutation object for the compressed vertices.
created -- 96may02, cca
------------------------------------------------
*/
Perm *
Perm_compress (
Perm *perm,
IV *eqmapIV
) {
int n, N, v, vcomp, vnew ;
int *eqmap, *head, *link, *newToOld, *oldToNew, *vals ;
Perm *perm2 ;
/*
---------------
check the input
---------------
*/
if ( perm == NULL
|| (n = perm->size) <= 0
|| eqmapIV == NULL
|| n != IV_size(eqmapIV)
|| (eqmap = IV_entries(eqmapIV)) == NULL ) {
fprintf(stderr, "\n fatal error in Perm_compress(%p,%p)"
"\n bad input\n", perm, eqmapIV) ;
if ( perm != NULL ) {
Perm_writeStats(perm, stderr) ;
}
if ( eqmapIV != NULL ) {
IV_writeStats(eqmapIV, stderr) ;
}
spoolesFatal();
}
n = perm->size ;
if ( (oldToNew = perm->oldToNew) == NULL ) {
Perm_fillOldToNew(perm) ;
oldToNew = perm->oldToNew ;
}
if ( (newToOld = perm->newToOld) == NULL ) {
Perm_fillNewToOld(perm) ;
newToOld = perm->newToOld ;
}
/*
---------------------------------
create the new permutation object
---------------------------------
*/
N = 1 + IVmax(n, eqmap, &v) ;
perm2 = Perm_new() ;
Perm_initWithTypeAndSize(perm2, 3, N) ;
/*
--------------------------------------------
get the head/link structure for the vertices
--------------------------------------------
*/
head = IVinit(N, -1) ;
link = IVinit(n, -1) ;
for ( v = 0 ; v < n ; v++ ) {
vcomp = eqmap[v] ;
link[v] = head[vcomp] ;
head[vcomp] = v ;
}
/*
---------------------------
get the two vectors to sort
---------------------------
*/
IVramp(N, perm2->newToOld, 0, 1) ;
vals = IVinit(N, -1) ;
for ( vcomp = 0 ; vcomp < N ; vcomp++ ) {
v = head[vcomp] ;
vnew = perm->oldToNew[v] ;
for ( v = link[v] ; v != -1 ; v = link[v] ) {
if ( vnew > perm->oldToNew[v] ) {
vnew = perm->oldToNew[v] ;
}
}
vals[vcomp] = vnew ;
}
IV2qsortUp(N, vals, perm2->newToOld) ;
for ( vcomp = 0 ; vcomp < N ; vcomp++ ) {
perm2->oldToNew[perm2->newToOld[vcomp]] = vcomp ;
}
/*
---------------------
free the working data
---------------------
*/
IVfree(head) ;
IVfree(link) ;
IVfree(vals) ;
return(perm2) ; }
