/*
----------------------------------------------
purpose -- to write the object for a human eye
created -- 98may01, cca
----------------------------------------------
*/
void
A2_writeForHumanEye (
A2 *mtx,
FILE *fp
) {
int i, j, jfirst, jlast, loc ;
if ( mtx == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in A2_writeForHumanEye(%p,%p)"
"\n bad input\n", mtx, fp) ;
spoolesFatal();
}
A2_writeStats(mtx, fp) ;
if ( A2_IS_REAL(mtx) ) {
for ( jfirst = 0 ; jfirst < mtx->n2 ; jfirst += 4 ) {
jlast = jfirst + 3 ;
if ( jlast >= mtx->n2 ) {
jlast = mtx->n2 - 1 ;
}
fprintf(fp, "\n ") ;
for ( j = jfirst ; j <= jlast ; j++ ) {
fprintf(fp, "%19d", j) ;
}
for ( i = 0 ; i < mtx->n1 ; i++ ) {
fprintf(fp, "\n%4d", i) ;
for ( j = jfirst ; j <= jlast ; j++ ) {
fprintf(fp, "%19.11e",
mtx->entries[i*mtx->inc1 + j*mtx->inc2]) ;
}
}
}
} else if ( A2_IS_COMPLEX(mtx) ) {
for ( jfirst = 0 ; jfirst < mtx->n2 ; jfirst += 2 ) {
jlast = jfirst + 1 ;
if ( jlast >= mtx->n2 ) {
jlast = mtx->n2 - 1 ;
}
fprintf(fp, "\n ") ;
for ( j = jfirst ; j <= jlast ; j++ ) {
fprintf(fp, "%36d", j) ;
}
for ( i = 0 ; i < mtx->n1 ; i++ ) {
fprintf(fp, "\n%4d", i) ;
for ( j = jfirst ; j <= jlast ; j++ ) {
loc = 2*(i*mtx->inc1 + j*mtx->inc2) ;
fprintf(fp, " (%16.9e,%16.9e*i)",
mtx->entries[loc], mtx->entries[loc+1]) ;
}
}
}
}
return ; }
/*
----------------------------------------------
sort the rows of the matrix in ascending order
of the rowids[] vector. on return, rowids is
in asending order. return value is the number
of row swaps made.
created -- 98apr15, cca
----------------------------------------------
*/
int
A2_sortRowsUp (
A2 *mtx,
int nrow,
int rowids[]
) {
int ii, minrow, minrowid, nswap, target ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || mtx->n1 < nrow || nrow < 0 || rowids == NULL ) {
fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
"\n bad input\n", mtx, nrow, rowids) ;
if ( mtx != NULL ) {
A2_writeStats(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sortRowsUp(%p,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, nrow, rowids, mtx->type) ;
exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc1 == 1 ) {
double *dvtmp ;
int jcol, ncol ;
int *ivtmp ;
/*
---------------------------------------------------
matrix is stored by columns, so permute each column
---------------------------------------------------
*/
ivtmp = IVinit(nrow, -1) ;
if ( A2_IS_REAL(mtx) ) {
dvtmp = DVinit(nrow, 0.0) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
dvtmp = DVinit(2*nrow, 0.0) ;
}
IVramp(nrow, ivtmp, 0, 1) ;
IV2qsortUp(nrow, rowids, ivtmp) ;
ncol = mtx->n2 ;
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
if ( A2_IS_REAL(mtx) ) {
DVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
DVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
ZVcopy(nrow, dvtmp, A2_column(mtx, jcol)) ;
ZVgather(nrow, A2_column(mtx, jcol), dvtmp, ivtmp) ;
}
}
IVfree(ivtmp) ;
DVfree(dvtmp) ;
} else {
/*
----------------------------------------
use a simple insertion sort to swap rows
----------------------------------------
*/
for ( target = 0 ; target < nrow ; target++ ) {
minrow = target ;
minrowid = rowids[target] ;
for ( ii = target + 1 ; ii < nrow ; ii++ ) {
if ( minrowid > rowids[ii] ) {
minrow = ii ;
minrowid = rowids[ii] ;
}
}
if ( minrow != target ) {
rowids[minrow] = rowids[target] ;
rowids[target] = minrowid ;
A2_swapRows(mtx, target, minrow) ;
nswap++ ;
}
}
}
return(nswap) ; }
/*
-------------------------------------------------
sort the columns of the matrix in ascending order
of the colids[] vector. on return, colids is
in asending order. return value is the number
of column swaps made.
created -- 98apr15, cca
-------------------------------------------------
*/
int
A2_sortColumnsUp (
A2 *mtx,
int ncol,
int colids[]
) {
int ii, mincol, mincolid, nswap, target ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || mtx->n2 < ncol || ncol < 0 || colids == NULL ) {
fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
"\n bad input\n", mtx, ncol, colids) ;
if ( mtx != NULL ) {
A2_writeStats(mtx, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sortColumnsUp(%p,%d,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, ncol, colids, mtx->type) ;
exit(-1) ;
}
nswap = 0 ;
if ( mtx->inc2 == 1 ) {
double *dvtmp ;
int irow, nrow ;
int *ivtmp ;
/*
---------------------------------------------------
matrix is stored by rows, so permute each row
---------------------------------------------------
*/
ivtmp = IVinit(ncol, -1) ;
if ( A2_IS_REAL(mtx) ) {
dvtmp = DVinit(ncol, 0.0) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
dvtmp = DVinit(2*ncol, 0.0) ;
}
IVramp(ncol, ivtmp, 0, 1) ;
IV2qsortUp(ncol, colids, ivtmp) ;
nrow = mtx->n1 ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
if ( A2_IS_REAL(mtx) ) {
DVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
DVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
ZVcopy(ncol, dvtmp, A2_row(mtx, irow)) ;
ZVgather(ncol, A2_row(mtx, irow), dvtmp, ivtmp) ;
}
}
IVfree(ivtmp) ;
DVfree(dvtmp) ;
} else {
/*
----------------------------------------
use a simple insertion sort to swap cols
----------------------------------------
*/
for ( target = 0 ; target < ncol ; target++ ) {
mincol = target ;
mincolid = colids[target] ;
for ( ii = target + 1 ; ii < ncol ; ii++ ) {
if ( mincolid > colids[ii] ) {
mincol = ii ;
mincolid = colids[ii] ;
}
}
if ( mincol != target ) {
colids[mincol] = colids[target] ;
colids[target] = mincolid ;
A2_swapColumns(mtx, target, mincol) ;
nswap++ ;
}
}
}
return(nswap) ; }
/*
----------------------------
copy one matrix into another
A := B
created -- 98may01, cca
----------------------------
*/
void
A2_copy (
A2 *A,
A2 *B
) {
double *entA, *entB ;
int inc1A, inc1B, inc2A, inc2B, irow, jcol, locA, locB,
ncol, ncolA, ncolB, nrow, nrowA, nrowB ;
/*
---------------
check the input
---------------
*/
if ( A == NULL
|| (nrowA = A->n1) < 0
|| (ncolA = A->n2) < 0
|| (inc1A = A->inc1) <= 0
|| (inc2A = A->inc2) <= 0
|| (entA = A->entries) == NULL
|| B == NULL
|| (nrowB = B->n1) < 0
|| (ncolB = B->n2) < 0
|| (inc1B = B->inc1) <= 0
|| (inc2B = B->inc2) <= 0
|| (entB = B->entries) == NULL ) {
fprintf(stderr, "\n fatal error in A2_copy(%p,%p)"
"\n bad input\n", A, B) ;
if ( A != NULL ) {
fprintf(stderr, "\n\n first A2 object") ;
A2_writeStats(A, stderr) ;
}
if ( B != NULL ) {
fprintf(stderr, "\n\n second A2 object") ;
A2_writeStats(B, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(A) || A2_IS_COMPLEX(A)) ) {
fprintf(stderr, "\n fatal error in A2_copy(%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
A, B, A->type) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(B) || A2_IS_COMPLEX(B)) ) {
fprintf(stderr, "\n fatal error in A2_copy(%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
A, B, B->type) ;
exit(-1) ;
}
if ( A->type != B->type ) {
fprintf(stderr, "\n fatal error in A2_copy(%p,%p)"
"\n A's type %d, B's type = %d, must be the same\n",
A, B, A->type, B->type) ;
exit(-1) ;
}
nrow = (nrowA <= nrowB) ? nrowA : nrowB ;
ncol = (ncolA <= ncolB) ? ncolA : ncolB ;
if ( A2_IS_REAL(A) ) {
if ( inc1A == 1 && inc1B == 1 ) {
double *colA = entA, *colB = entB ;
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
for ( irow = 0 ; irow < nrow ; irow++ ) {
colA[irow] = colB[irow] ;
}
colA += inc2A ;
colB += inc2B ;
}
} else if ( inc2A == 1 && inc2B == 1 ) {
double *rowA = entA, *rowB = entB ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
rowA[jcol] = rowB[jcol] ;
}
rowA += 2*inc1A ;
}
} else {
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
locA = irow*inc1A + jcol*inc2A ;
locB = irow*inc1B + jcol*inc2B ;
entA[locA] = entB[locB] ;
}
}
}
} else if ( A2_IS_COMPLEX(A) ) {
if ( inc1A == 1 && inc1B == 1 ) {
double *colA = entA, *colB = entB ;
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
for ( irow = 0 ; irow < nrow ; irow++ ) {
colA[2*irow] = colB[2*irow] ;
colA[2*irow+1] = colB[2*irow+1] ;
}
colA += 2*inc2A ;
colB += 2*inc2B ;
}
} else if ( inc2A == 1 && inc2B == 1 ) {
double *rowA = entA, *rowB = entB ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
rowA[2*jcol] = rowB[2*jcol] ;
rowA[2*jcol+1] = rowB[2*jcol+1] ;
}
rowA += 2*inc1A ;
rowB += 2*inc1B ;
}
} else {
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
locA = irow*inc1A + jcol*inc2A ;
locB = irow*inc1B + jcol*inc2B ;
entA[2*locA] = entB[2*locB] ;
entA[2*locA+1] = entB[2*locB+1] ;
}
}
}
}
return ; }
/*
--------------------------------
subtract one matrix from another
A := A - B
created -- 98may01, cca
----------------------------
*/
void
A2_sub (
A2 *A,
A2 *B
) {
double *entA, *entB ;
int inc1A, inc1B, inc2A, inc2B, irow, jcol, locA, locB,
ncol, ncolA, ncolB, nrow, nrowA, nrowB ;
/*
---------------
check the input
---------------
*/
if ( A == NULL
|| B == NULL
|| (nrowA = A->n1) <= 0
|| (ncolA = A->n2) <= 0
|| (inc1A = A->inc1) <= 0
|| (inc2A = A->inc2) <= 0
|| (nrowB = B->n1) <= 0
|| (ncolB = B->n2) <= 0
|| (inc1B = B->inc1) <= 0
|| (inc2B = B->inc2) <= 0
|| (entA = A->entries) == NULL
|| (entB = B->entries) == NULL ) {
fprintf(stderr, "\n fatal error in A2_sub(%p,%p)"
"\n bad input\n", A, B) ;
if ( A != NULL ) {
fprintf(stderr, "\n\n first A2 object") ;
A2_writeStats(A, stderr) ;
}
if ( B != NULL ) {
fprintf(stderr, "\n\n second A2 object") ;
A2_writeStats(B, stderr) ;
}
exit(-1) ;
}
if ( ! (A2_IS_REAL(A) || A2_IS_COMPLEX(A)) ) {
fprintf(stderr, "\n fatal error in A2_sub(%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
A, B, A->type) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(B) || A2_IS_COMPLEX(B)) ) {
fprintf(stderr, "\n fatal error in A2_sub(%p,%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
A, B, B->type) ;
exit(-1) ;
}
if ( A->type != B->type ) {
fprintf(stderr, "\n fatal error in A2_sub(%p,%p)"
"\n A's type %d, B's type = %d, must be the same\n",
A, B, A->type, B->type) ;
exit(-1) ;
}
/*
fprintf(stdout, "\n debug : A") ;
A2_writeForHumanEye(A, stdout) ;
fprintf(stdout, "\n debug : B") ;
A2_writeForHumanEye(B, stdout) ;
*/
nrow = (nrowA <= nrowB) ? nrowA : nrowB ;
ncol = (ncolA <= ncolB) ? ncolA : ncolB ;
if ( A2_IS_REAL(A) ) {
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
locA = irow*inc1A + jcol*inc2A ;
locB = irow*inc1B + jcol*inc2B ;
entA[locA] -= entB[locB] ;
}
}
} else if ( A2_IS_COMPLEX(A) ) {
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
locA = irow*inc1A + jcol*inc2A ;
locB = irow*inc1B + jcol*inc2B ;
entA[2*locA] -= entB[2*locB] ;
entA[2*locA+1] -= entB[2*locB+1] ;
}
}
}
return ; }
