/*
---------------------------------------
purpose -- to write an object to a file
input --
fn -- filename
*.a2b -- binary
*.a2f -- formatted
anything else -- for human eye
created -- 98may01, cca
---------------------------------------
*/
void
A2_writeToFile (
A2 *mtx,
char *fn
) {
FILE *fp ;
int fnlength, sulength ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || fn == NULL ) {
fprintf(stderr, "\n fatal error in A2_writeToFile(%p,%s)"
"\n bad input", mtx, fn) ;
}
/*
------------------
write out the file
------------------
*/
fnlength = strlen(fn) ;
sulength = strlen(suffixb) ;
if ( fnlength > sulength ) {
if ( strcmp(&fn[fnlength-sulength], suffixb) == 0 ) {
if ( (fp = fopen(fn, "wb")) == NULL ) {
fprintf(stderr, "\n error in A2_writeToFile()"
"\n unable to open file %s", fn) ;
} else {
A2_writeToBinaryFile(mtx, fp) ;
fclose(fp) ;
}
} else if ( strcmp(&fn[fnlength-sulength], suffixf) == 0 ) {
if ( (fp = fopen(fn, "w")) == NULL ) {
fprintf(stderr, "\n error in A2_writeToFile()"
"\n unable to open file %s", fn) ;
} else {
A2_writeToFormattedFile(mtx, fp) ;
fclose(fp) ;
}
} else {
if ( (fp = fopen(fn, "a")) == NULL ) {
fprintf(stderr, "\n error in A2_writeToFile()"
"\n unable to open file %s", fn) ;
} else {
A2_writeForHumanEye(mtx, fp) ;
fclose(fp) ;
}
}
} else {
if ( (fp = fopen(fn, "a")) == NULL ) {
fprintf(stderr, "\n error in A2_writeToFile"
"\n unable to open file %s", fn) ;
} else {
A2_writeForHumanEye(mtx, fp) ;
fclose(fp) ;
}
}
return ; }
/*
----------------------------------------
purpose -- to write the object to a file
in human readable form
return value --
1 -- normal return
-1 -- mtx is NULL
-2 -- fp is NULL
created -- 98may02, cca
----------------------------------------
*/
int
DenseMtx_writeForHumanEye (
DenseMtx *mtx,
FILE *fp
) {
A2 a2 ;
int ierr, ncol, nrow ;
int *colind, *rowind ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in DenseMtx_writeForHumanEye()"
"\n mtx is NULL\n") ;
return(-1) ;
}
if ( fp == NULL ) {
fprintf(stderr, "\n fatal error in DenseMtx_writeForHumanEye()"
"\n mtx is NULL\n") ;
return(-2) ;
}
DenseMtx_writeStats(mtx, fp) ;
DenseMtx_rowIndices(mtx, &nrow, &rowind) ;
if ( nrow > 0 && rowind != NULL ) {
fprintf(fp, "\n mtx's row indices at %p", rowind) ;
IVfp80(fp, nrow, rowind, 80, &ierr) ;
}
DenseMtx_columnIndices(mtx, &ncol, &colind) ;
if ( ncol > 0 && colind != NULL ) {
fprintf(fp, "\n mtx's column indices at %p", colind) ;
IVfp80(fp, ncol, colind, 80, &ierr) ;
}
if ( nrow > 0 && ncol > 0 ) {
A2_setDefaultFields(&a2) ;
DenseMtx_setA2(mtx, &a2) ;
A2_writeForHumanEye(&a2, fp) ;
}
return(1) ; }
/*--------------------------------------------------------------------*/
int
main ( int argc, char *argv[] )
/*
-----------------------
simple test program
created -- 98apr15, cca
-----------------------
*/
{
A2 *A ;
double t1, t2, value ;
FILE *msgFile ;
int inc1, inc2, irow, jcol,
msglvl, nrow, ncol, seed, type ;
if ( argc != 9 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile type nrow ncol inc1 inc2 seed "
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n type -- entries type"
"\n 1 -- real"
"\n 2 -- complex"
"\n nrow -- # of rows "
"\n ncol -- # of columns "
"\n inc1 -- row increment "
"\n inc2 -- column increment "
"\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]) ;
nrow = atoi(argv[4]) ;
ncol = atoi(argv[5]) ;
inc1 = atoi(argv[6]) ;
inc2 = atoi(argv[7]) ;
if ( type < 1 || type > 2 || nrow < 0 || ncol < 0
|| inc1 < 1 || inc2 < 1 ) {
fprintf(stderr,
"\n fatal error, type %d, nrow %d, ncol %d, inc1 %d, inc2 %d",
type, nrow, ncol, inc1, inc2) ;
spoolesFatal();
}
seed = atoi(argv[7]) ;
fprintf(msgFile, "\n\n %% %s :"
"\n %% msglvl = %d"
"\n %% msgFile = %s"
"\n %% type = %d"
"\n %% nrow = %d"
"\n %% ncol = %d"
"\n %% inc1 = %d"
"\n %% inc2 = %d"
"\n %% seed = %d"
"\n",
argv[0], msglvl, argv[2], type, nrow, ncol, inc1, inc2, seed) ;
/*
-----------------------------
initialize the matrix objects
-----------------------------
*/
MARKTIME(t1) ;
A = A2_new() ;
A2_init(A, type, nrow, ncol, inc1, inc2, NULL) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n %% CPU : %.3f to initialize matrix object",
t2 - t1) ;
MARKTIME(t1) ;
A2_fillRandomUniform(A, -1, 1, seed) ;
seed++ ;
MARKTIME(t2) ;
fprintf(msgFile,
"\n %% CPU : %.3f to fill matrix with random numbers", t2 - t1) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n matrix A") ;
A2_writeForHumanEye(A, msgFile) ;
}
if ( msglvl > 1 ) {
fprintf(msgFile, "\n %% matrix A") ;
A2_writeForMatlab(A, "A", msgFile) ;
}
/*
-------------
get the norms
-------------
*/
value = A2_maxabs(A) ;
fprintf(msgFile, "\n error_maxabs = abs(%20.12e - max(max(abs(A))))",
value) ;
value = A2_frobNorm(A) ;
fprintf(msgFile, "\n error_frob = abs(%20.12e - norm(A, 'fro'))",
value) ;
value = A2_oneNorm(A) ;
fprintf(msgFile, "\n error_one = abs(%20.12e - norm(A, 1))",
value) ;
value = A2_infinityNorm(A) ;
fprintf(msgFile, "\n error_inf = abs(%20.12e - norm(A, inf))",
value) ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
value = A2_infinityNormOfRow(A, irow) ;
fprintf(msgFile,
"\n error_infNormsOfRows(%d) = abs(%20.12e - norm(A(%d,:), inf)) ;",
irow+1, value, irow+1) ;
value = A2_oneNormOfRow(A, irow) ;
fprintf(msgFile,
"\n error_oneNormsOfRows(%d) = abs(%20.12e - norm(A(%d,:), 1)) ;",
irow+1, value, irow+1) ;
value = A2_twoNormOfRow(A, irow) ;
fprintf(msgFile,
"\n error_twoNormsOfRows(%d) = abs(%20.12e - norm(A(%d,:), 2)) ;",
irow+1, value, irow+1) ;
}
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
value = A2_infinityNormOfColumn(A, jcol) ;
fprintf(msgFile,
"\n error_infNormsOfColumns(%d) = abs(%20.12e - norm(A(:,%d), inf)) ;",
jcol+1, value, jcol+1) ;
value = A2_oneNormOfColumn(A, jcol) ;
fprintf(msgFile,
"\n error_oneNormsOfColumns(%d) = abs(%20.12e - norm(A(:,%d), 1)) ;",
jcol+1, value, jcol+1) ;
value = A2_twoNormOfColumn(A, jcol) ;
fprintf(msgFile,
"\n error_twoNormsOfColumns(%d) = abs(%20.12e - norm(A(:,%d), 2)) ;",
jcol+1, value, jcol+1) ;
}
fprintf(msgFile,
"\n error_in_row_norms = [ max(error_infNormsOfRows) "
"\n max(error_oneNormsOfRows) "
"\n max(error_twoNormsOfRows) ]"
"\n error_in_column_norms = [ max(error_infNormsOfColumns) "
"\n max(error_oneNormsOfColumns) "
"\n max(error_twoNormsOfColumns) ]") ;
fprintf(msgFile, "\n") ;
/*
------------------------
free the working storage
------------------------
*/
A2_free(A) ;
return(0) ; }
/*
----------------------------------------------------
store the factor entries of the reduced front matrix
created -- 98may25, cca
----------------------------------------------------
*/
void
FrontMtx_QR_storeFront (
FrontMtx *frontmtx,
int J,
A2 *frontJ,
int msglvl,
FILE *msgFile
) {
A2 tempA2 ;
double fac, ifac, imag, real, rfac ;
double *entDJJ, *entUJJ, *entUJN, *row ;
int inc1, inc2, irow, jcol, ncol, ncolJ, nD, nentD, nentUJJ,
nfront, nrow, nU ;
int *colind, *colindJ, *firstlocs, *sizes ;
SubMtx *mtx ;
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || frontJ == NULL
|| (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr, "\n fatal error in FrontMtx_QR_storeFront()"
"\n bad input\n") ;
exit(-1) ;
}
nfront = FrontMtx_nfront(frontmtx) ;
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
nrow = A2_nrow(frontJ) ;
ncol = A2_ncol(frontJ) ;
A2_setDefaultFields(&tempA2) ;
nD = FrontMtx_frontSize(frontmtx, J) ;
nU = ncol - nD ;
/*
--------------------------------------
scale the rows and square the diagonal
--------------------------------------
*/
row = A2_entries(frontJ) ;
if ( A2_IS_REAL(frontJ) ) {
for ( irow = 0 ; irow < nD ; irow++ ) {
if ( row[irow] != 0.0 ) {
fac = 1./row[irow] ;
for ( jcol = irow + 1 ; jcol < ncol ; jcol++ ) {
row[jcol] *= fac ;
}
row[irow] = row[irow] * row[irow] ;
}
row += ncol ;
}
} else if ( A2_IS_COMPLEX(frontJ) ) {
for ( irow = 0 ; irow < nD ; irow++ ) {
real = row[2*irow] ; imag = row[2*irow+1] ;
if ( real != 0.0 || imag != 0.0 ) {
Zrecip(real, imag, &rfac, &ifac) ;
ZVscale(ncol - irow - 1, & row[2*irow+2], rfac, ifac) ;
row[2*irow] = real*real + imag*imag ;
row[2*irow+1] = 0.0 ;
}
row += 2*ncol ;
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n after scaling rows of A") ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
/*
-------------------------
copy the diagonal entries
-------------------------
*/
mtx = FrontMtx_diagMtx(frontmtx, J) ;
SubMtx_diagonalInfo(mtx, &nentD, &entDJJ) ;
A2_subA2(&tempA2, frontJ, 0, nD-1, 0, nD-1) ;
A2_copyEntriesToVector(&tempA2, nentD, entDJJ,
A2_DIAGONAL, A2_BY_ROWS) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVcopy(nD, colind, colindJ) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n diagonal factor matrix") ;
SubMtx_writeForHumanEye(mtx, msgFile) ;
fflush(msgFile) ;
}
if ( (mtx = FrontMtx_upperMtx(frontmtx, J, J)) != NULL ) {
/*
------------------------
copy the U_{J,J} entries
------------------------
*/
SubMtx_denseSubcolumnsInfo(mtx, &nD, &nentUJJ,
&firstlocs, &sizes, &entUJJ) ;
A2_copyEntriesToVector(&tempA2, nentUJJ, entUJJ,
A2_STRICT_UPPER, A2_BY_COLUMNS) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVcopy(nD, colind, colindJ) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n UJJ factor matrix") ;
SubMtx_writeForHumanEye(mtx, msgFile) ;
fflush(msgFile) ;
}
}
if ( ncolJ > nD ) {
/*
-----------------------------
copy the U_{J,bnd{J}} entries
-----------------------------
*/
mtx = FrontMtx_upperMtx(frontmtx, J, nfront) ;
SubMtx_denseInfo(mtx, &nD, &nU, &inc1, &inc2, &entUJN) ;
A2_subA2(&tempA2, frontJ, 0, nD-1, nD, ncolJ-1) ;
A2_copyEntriesToVector(&tempA2, nD*nU, entUJN,
A2_ALL_ENTRIES, A2_BY_COLUMNS) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVcopy(nU, colind, colindJ + nD) ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n UJN factor matrix") ;
SubMtx_writeForHumanEye(mtx, msgFile) ;
fflush(msgFile) ;
}
}
return ; }
/*
--------------------------------------------------------------
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) ; }
/*
-----------------------------------------------
purpose -- visit front J during a serial
or multithreaded QR factorization
cpus[1] -- initialize and load staircase matrix
cpus[2] -- factor the matrix
cpus[3] -- scale and store factor entries
cpus[4] -- store update entries
created -- 98may28, cca
-----------------------------------------------
*/
void
FrontMtx_QR_factorVisit (
FrontMtx *frontmtx,
int J,
InpMtx *mtxA,
IVL *rowsIVL,
int firstnz[],
ChvList *updlist,
ChvManager *chvmanager,
char status[],
int colmap[],
DV *workDV,
double cpus[],
double *pfacops,
int msglvl,
FILE *msgFile
) {
/*
---------------
check the input
---------------
*/
if ( frontmtx == NULL || mtxA == NULL || rowsIVL == NULL
|| firstnz == NULL || updlist == NULL || chvmanager == NULL
|| status == NULL || colmap == NULL || workDV == NULL
|| cpus == NULL || pfacops == NULL
|| (msglvl > 0 && msgFile == NULL) ) {
fprintf(msgFile, "\n fatal error in FrontMtx_QR_factorVisit(%d)"
"\n bad input\n", J) ;
exit(-1) ;
}
/*
------------------------------------------------------------
check to see if all incoming updates are present in the list
------------------------------------------------------------
*/
if ( ChvList_isCountZero(updlist, J) == 1 ) {
A2 *frontJ ;
Chv *firstchild, *updchv ;
double ops, t1, t2 ;
int K ;
/*
----------------------------------------
everything is ready to factor this front
----------------------------------------
*/
firstchild = ChvList_getList(updlist, J) ;
/*
----------------------------------------
initialize and load the staircase matrix
----------------------------------------
*/
MARKTIME(t1) ;
frontJ = FrontMtx_QR_assembleFront(frontmtx, J, mtxA, rowsIVL,
firstnz, colmap, firstchild,
workDV, msglvl, msgFile) ;
if ( firstchild != NULL ) {
ChvManager_releaseListOfObjects(chvmanager, firstchild) ;
}
MARKTIME(t2) ;
cpus[1] += t2 - t1 ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n after assembling front") ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
/*
---------------------------
factor the staircase matrix
---------------------------
*/
MARKTIME(t1) ;
ops = A2_QRreduce(frontJ, workDV, msglvl, msgFile) ;
*pfacops += ops ;
MARKTIME(t2) ;
cpus[2] += t2 - t1 ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n after factoring") ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
/*
----------------------------------
scale and store the factor entries
----------------------------------
*/
MARKTIME(t1) ;
FrontMtx_QR_storeFront(frontmtx, J, frontJ, msglvl, msgFile) ;
MARKTIME(t2) ;
cpus[3] += t2 - t1 ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n after storing factor entries") ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------
store the update matrix
-----------------------
*/
if ( (K = frontmtx->tree->par[J]) != -1 ) {
MARKTIME(t1) ;
updchv = FrontMtx_QR_storeUpdate(frontmtx, J, frontJ, chvmanager,
msglvl, msgFile) ;
ChvList_addObjectToList(updlist, updchv, K) ;
MARKTIME(t2) ;
cpus[4] += t2 - t1 ;
if ( msglvl > 3 ) {
fprintf(msgFile, "\n\n after storing update entries") ;
A2_writeForHumanEye(frontJ, msgFile) ;
fflush(msgFile) ;
}
}
/*
-------------------------
free the staircase matrix
-------------------------
*/
A2_free(frontJ) ;
/*
-------------------------------------
set the status as finished and return
-------------------------------------
*/
status[J] = 'F' ;
}
return ; }
/*
----------------------------------------
purpose -- to write the object to a file
in human readable form
created -- 98apr30, cca
----------------------------------------
*/
void
Chv_writeForHumanEye (
Chv *chv,
FILE *fp
) {
A2 mtx ;
int ierr, ncol, nD, nL, nrow, nU ;
int *colind, *rowind ;
/*
---------------
check the input
---------------
*/
if ( chv == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in Chv_writeForHumanEye(%p,%p)"
"\n bad input\n", chv, fp) ;
exit(-1) ;
}
Chv_dimensions(chv, &nD, &nL, &nU) ;
fprintf(fp,
"\n Chv object at address %p"
"\n id = %d, nD = %d, nL = %d, nU = %d, type = %d, symflag = %d",
chv, chv->id, nD, nL, nU, chv->type, chv->symflag) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) ) {
fprintf(fp, "\n chv is real and symmetric") ;
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
fprintf(fp, "\n chv is real and nonsymmetric") ;
} else {
fprintf(fp, "\n chv has unknown symmetry type %d", chv->symflag) ;
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) ) {
fprintf(fp, "\n chv is complex and symmetric") ;
} else if ( CHV_IS_HERMITIAN(chv) ) {
fprintf(fp, "\n chv is complex and hermitian") ;
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
fprintf(fp, "\n chv is complex and nonsymmetric") ;
} else {
fprintf(fp, "\n chv has unknown symmetry type %d", chv->symflag) ;
}
} else {
fprintf(fp, "\n chv has unknown type %d", chv->type) ;
}
Chv_rowIndices(chv, &nrow, &rowind) ;
if ( nrow > 0 && rowind != NULL ) {
fprintf(fp, "\n chv's row indices at %p", rowind) ;
IVfp80(fp, nrow, rowind, 80, &ierr) ;
}
Chv_columnIndices(chv, &ncol, &colind) ;
if ( ncol > 0 && colind != NULL ) {
fprintf(fp, "\n chv's column indices at %p", colind) ;
IVfp80(fp, ncol, colind, 80, &ierr) ;
}
/*
--------------------
load the (1,1) block
--------------------
*/
A2_setDefaultFields(&mtx) ;
Chv_fill11block(chv, &mtx) ;
fprintf(fp, "\n (1,1) block") ;
A2_writeForHumanEye(&mtx, fp) ;
if ( nU > 0 ) {
/*
--------------------
load the (1,2) block
--------------------
*/
Chv_fill12block(chv, &mtx) ;
fprintf(fp, "\n (1,2) block") ;
A2_writeForHumanEye(&mtx, fp) ;
}
if ( nL > 0 && CHV_IS_NONSYMMETRIC(chv) == 1 ) {
/*
--------------------
load the (2,1) block
--------------------
*/
Chv_fill21block(chv, &mtx) ;
fprintf(fp, "\n (2,1) block") ;
A2_writeForHumanEye(&mtx, fp) ;
}
A2_clearData(&mtx) ;
return ; }
