/*
------------------------------------------------------------
load entries from sigma*A
chv -- pointer to the Chv object that holds the front
pencil -- pointer to a Pencil that holds the matrix entries
msglvl -- message level
msgFile -- message file
created -- 97jul18, cca
------------------------------------------------------------
*/
void
FrontMtx_loadEntries (
Chv *chv,
Pencil *pencil,
int msglvl,
FILE *msgFile
) {
InpMtx *inpmtxA, *inpmtxB ;
double one[2] = {1.0,0.0} ;
double *sigma ;
double *chvent ;
int chvsize, ichv, ncol, nD, nL, nU ;
int *chvind, *colind ;
/*
---------------
check the input
---------------
*/
if ( chv == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr,
"\n fatal error in FrontMtx_loadEntries(%p,%p,%d,%p)"
"\n bad input\n", chv, pencil, msglvl, msgFile) ;
exit(-1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile,
"\n\n # inside loadEntries for chv %d"
", sigma = %12.4e + i*%12.4e",
chv->id, pencil->sigma[0], pencil->sigma[1]) ;
fflush(msgFile) ;
}
Chv_dimensions(chv, &nD, &nL, &nU) ;
Chv_columnIndices(chv, &ncol, &colind) ;
/*
----------------------------------------
load the original entries, A + sigma * B
----------------------------------------
*/
inpmtxA = pencil->inpmtxA ;
sigma = pencil->sigma ;
inpmtxB = pencil->inpmtxB ;
if ( inpmtxA != NULL ) {
int ii ;
/*
-------------------
load entries from A
-------------------
*/
for ( ii = 0 ; ii < nD ; ii++ ) {
ichv = colind[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxA) ) {
InpMtx_realVector(inpmtxA, ichv, &chvsize, &chvind, &chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
InpMtx_complexVector(inpmtxA,
ichv, &chvsize, &chvind, &chvent) ;
}
if ( chvsize > 0 ) {
if ( msglvl > 3 ) {
int ierr ;
fprintf(msgFile, "\n inpmtxA chevron %d : chvsize = %d",
ichv, chvsize) ;
fprintf(msgFile, "\n chvind") ;
IVfp80(msgFile, chvsize, chvind, 80, &ierr) ;
fprintf(msgFile, "\n chvent") ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, chvsize, chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, 2*chvsize, chvent) ;
}
fflush(msgFile) ;
}
Chv_addChevron(chv, one, ichv, chvsize, chvind, chvent) ;
}
}
} else {
double *entries ;
int ii, off, stride ;
/*
-----------------
load the identity
-----------------
*/
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += 1.0 ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += 1.0 ;
off += stride ;
stride -= 2 ;
}
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += 1.0 ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += 1.0 ;
off += stride ;
stride -= 2 ;
}
}
}
}
if ( inpmtxB != NULL ) {
int ii ;
/*
-------------------------
load entries from sigma*B
-------------------------
*/
for ( ii = 0 ; ii < nD ; ii++ ) {
ichv = colind[ii] ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxB) ) {
InpMtx_realVector(inpmtxB, ichv, &chvsize, &chvind, &chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
InpMtx_complexVector(inpmtxB,
ichv, &chvsize, &chvind, &chvent) ;
}
if ( chvsize > 0 ) {
if ( msglvl > 3 ) {
int ierr ;
fprintf(msgFile, "\n inpmtxB chevron %d : chvsize = %d",
ichv, chvsize) ;
fprintf(msgFile, "\n chvind") ;
IVfp80(msgFile, chvsize, chvind, 80, &ierr) ;
fprintf(msgFile, "\n chvent") ;
if ( INPMTX_IS_REAL_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, chvsize, chvent) ;
} else if ( INPMTX_IS_COMPLEX_ENTRIES(inpmtxA) ) {
DVfprintf(msgFile, 2*chvsize, chvent) ;
}
}
Chv_addChevron(chv, sigma, ichv, chvsize, chvind, chvent) ;
}
}
} else {
double *entries ;
int ii, off, stride ;
/*
--------------------------------------
load a scalar multiple of the identity
--------------------------------------
*/
entries = Chv_entries(chv) ;
if ( CHV_IS_REAL(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) ) {
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += sigma[0] ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[off] += sigma[0] ;
off += stride ;
stride -= 2 ;
}
}
} else if ( CHV_IS_COMPLEX(chv) ) {
if ( CHV_IS_SYMMETRIC(chv) || CHV_IS_HERMITIAN(chv) ) {
if ( CHV_IS_HERMITIAN(chv) && sigma[1] != 0.0 ) {
fprintf(stderr,
"\n fatal error in FrontMtx_loadEntries()"
"\n chevron is hermitian"
"\n sigma = %12.4e + %12.4e*i\n",
sigma[0], sigma[1]) ;
exit(-1) ;
}
stride = nD + chv->nU ;
off = 0 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += sigma[0] ;
entries[2*off+1] += sigma[1] ;
off += stride ;
stride-- ;
}
} else if ( CHV_IS_NONSYMMETRIC(chv) ) {
stride = 2*nD + chv->nL + chv->nU - 2 ;
off = nD + chv->nL - 1 ;
for ( ii = 0 ; ii < nD ; ii++ ) {
entries[2*off] += sigma[0] ;
entries[2*off+1] += sigma[1] ;
off += stride ;
stride -= 2 ;
}
}
}
}
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) ; }