/*
-------------------------------------------------
expand an ETree object by splitting a large front
into a chain of smaller fronts.
created -- 96jun27, cca
-------------------------------------------------
*/
ETree *
ETree_splitFronts (
ETree *etree,
int vwghts[],
int maxfrontsize,
int seed
) {
ETree *etree2 ;
int count, front, ii, I, Inew, J, Jnew, nbnd, newsize, nint, nfront,
nfront2, nsplit, nvtx, prev, size, sizeJ, v, vwght ;
int *bndwghts, *fch, *head, *indices, *link, *newbndwghts, *newmap,
*newnodwghts, *newpar, *nodwghts, *roots, *sib, *vtxToFront ;
Tree *tree ;
/*
---------------
check the input
---------------
*/
if ( etree == NULL
|| (nfront = etree->nfront) <= 0
|| (nvtx = etree->nvtx) <= 0
|| maxfrontsize <= 0 ) {
fprintf(stderr, "\n fatal error in ETree_splitFronts(%p,%p,%d,%d)"
"\n bad input\n", etree, vwghts, maxfrontsize, seed) ;
spoolesFatal();
}
tree = etree->tree ;
fch = tree->fch ;
sib = tree->sib ;
nodwghts = IV_entries(etree->nodwghtsIV) ;
bndwghts = IV_entries(etree->bndwghtsIV) ;
vtxToFront = IV_entries(etree->vtxToFrontIV) ;
/*
--------------------------
set up the working storage
--------------------------
*/
newpar = IVinit(nvtx, -1) ;
roots = IVinit(nfront, -1) ;
newmap = IVinit(nvtx, -1) ;
newnodwghts = IVinit(nvtx, -1) ;
newbndwghts = IVinit(nvtx, -1) ;
head = IVinit(nfront, -1) ;
link = IVinit(nvtx, -1) ;
indices = IVinit(nvtx, -1) ;
for ( v = 0 ; v < nvtx ; v++ ) {
front = vtxToFront[v] ;
link[v] = head[front] ;
head[front] = v ;
}
/*
------------------------------------------------
execute a post-order traversal of the front tree
------------------------------------------------
*/
nfront2 = 0 ;
for ( J = Tree_postOTfirst(tree) ;
J != -1 ;
J = Tree_postOTnext(tree, J) ) {
sizeJ = 0 ;
for ( v = head[J], count = 0 ; v != -1 ; v = link[v] ) {
indices[count++] = v ;
vwght = (vwghts != NULL) ? vwghts[v] : 1 ;
sizeJ += vwght ;
}
if ( sizeJ != nodwghts[J] ) {
fprintf(stderr, "\n fatal error in ETree_splitFronts(%p,%p,%d,%d)"
"\n J = %d, sizeJ = %d, nodwght = %d\n",
etree, vwghts, maxfrontsize, seed, J, sizeJ, nodwghts[J]) ;
spoolesFatal();
}
#if MYDEBUG > 0
fprintf(stdout, "\n\n checking out front %d, size %d", J, sizeJ) ;
#endif
if ( sizeJ <= maxfrontsize || fch[J] == -1 ) {
/*
-------------------------------------------
this front is small enough (or is a domain)
-------------------------------------------
*/
Jnew = nfront2++ ;
for ( ii = 0 ; ii < count ; ii++ ) {
v = indices[ii] ;
newmap[v] = Jnew ;
#if MYDEBUG > 1
fprintf(stdout, "\n mapping vertex %d into new front %d",
v, Jnew) ;
#endif
}
for ( I = fch[J] ; I != -1 ; I = sib[I] ) {
Inew = roots[I] ;
newpar[Inew] = Jnew ;
}
newnodwghts[Jnew] = nodwghts[J] ;
newbndwghts[Jnew] = bndwghts[J] ;
roots[J] = Jnew ;
#if MYDEBUG > 0
fprintf(stdout, "\n front is small enough, Jnew = %d", Jnew) ;
#endif
} else {
/*
------------------------------------------
this front is too large, split into pieces
whose size differs by one vertex
------------------------------------------
*/
nsplit = (sizeJ + maxfrontsize - 1)/maxfrontsize ;
newsize = sizeJ / nsplit ;
if ( sizeJ % nsplit != 0 ) {
newsize++ ;
}
#if MYDEBUG > 0
fprintf(stdout,
"\n front is too large, %d target fronts, target size = %d",
nsplit, newsize) ;
#endif
prev = -1 ;
nint = nodwghts[J] ;
nbnd = nint + bndwghts[J] ;
if ( seed > 0 ) {
IVshuffle(count, indices, seed) ;
}
ii = 0 ;
while ( ii < count ) {
Jnew = nfront2++ ;
size = 0 ;
while ( ii < count ) {
v = indices[ii] ;
vwght = (vwghts != NULL) ? vwghts[v] : 1 ;
#if MYDEBUG > 0
fprintf(stdout,
"\n ii = %d, v = %d, vwght = %d, size = %d",
ii, v, vwght, size) ;
#endif
/*
-----------------------------------------------
97aug28, cca
bug fix. front is created even if it is too big
-----------------------------------------------
*/
if ( newsize >= size + vwght || size == 0 ) {
newmap[v] = Jnew ;
size += vwght ;
#if MYDEBUG > 0
fprintf(stdout,
"\n mapping vertex %d into new front %d, size = %d",
v, Jnew, size) ;
#endif
ii++ ;
} else {
break ;
}
}
if ( prev == -1 ) {
for ( I = fch[J] ; I != -1 ; I = sib[I] ) {
Inew = roots[I] ;
newpar[Inew] = Jnew ;
}
} else {
newpar[prev] = Jnew ;
}
prev = Jnew ;
newnodwghts[Jnew] = size ;
nbnd = nbnd - size ;
newbndwghts[Jnew] = nbnd ;
#if MYDEBUG > 0
fprintf(stdout, "\n new front %d, size %d, bnd %d",
Jnew, newnodwghts[Jnew], newbndwghts[Jnew]) ;
#endif
}
roots[J] = Jnew ;
}
}
/*
---------------------------
create the new ETree object
---------------------------
*/
etree2 = ETree_new() ;
ETree_init1(etree2, nfront2, nvtx) ;
IVcopy(nfront2, etree2->tree->par, newpar) ;
Tree_setFchSibRoot(etree2->tree) ;
IVcopy(nvtx, IV_entries(etree2->vtxToFrontIV), newmap) ;
IVcopy(nfront2, IV_entries(etree2->nodwghtsIV), newnodwghts) ;
IVcopy(nfront2, IV_entries(etree2->bndwghtsIV), newbndwghts) ;
/*
------------------------
free the working storage
------------------------
*/
IVfree(newpar) ;
IVfree(roots) ;
IVfree(newmap) ;
IVfree(newnodwghts) ;
IVfree(newbndwghts) ;
IVfree(head) ;
IVfree(link) ;
IVfree(indices) ;
return(etree2) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
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) ; }
/*--------------------------------------------------------------------*/
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) ; }
