/*
----------------------------------------------
return the number of bytes taken by the object
created -- 98may01, cca
----------------------------------------------
*/
int
A2_sizeOf (
A2 *mtx
) {
int nbytes ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in A2_sizeOf(%p)"
"\n bad input\n", mtx) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_sizeOf(%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, mtx->type) ;
exit(-1) ;
}
if ( A2_IS_REAL(mtx) ) {
nbytes = sizeof(struct _A2) + mtx->nowned*sizeof(double) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
nbytes = sizeof(struct _A2) + 2*mtx->nowned*sizeof(double) ;
}
return(nbytes) ; }
/*
---------------------------------------------------------------
shift the base of the entries and adjust dimensions
mtx(0:n1-rowoff-1,0:n2-coloff-1) = mtx(rowoff:n1-1,coloff:n2-1)
created -- 98may01, cca
---------------------------------------------------------------
*/
void
A2_shiftBase (
A2 *mtx,
int rowoff,
int coloff
) {
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in A2_shiftbase(%p,%d,%d)"
"\n bad input\n", mtx, rowoff, coloff) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_shiftBase(%p,%d,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, rowoff, coloff, mtx->type) ;
exit(-1) ;
}
mtx->n1 -= rowoff ;
mtx->n2 -= coloff ;
if ( A2_IS_REAL(mtx) ) {
mtx->entries += rowoff*mtx->inc1 + coloff*mtx->inc2 ;
} else if ( A2_IS_COMPLEX(mtx) ) {
mtx->entries += 2*(rowoff*mtx->inc1 + coloff*mtx->inc2) ;
}
return ; }
/*
-----------------------------------------------
fill the matrix with normal(0,1) random numbers
created -- 98may01, cca
-----------------------------------------------
*/
void
A2_fillRandomNormal (
A2 *a,
double mean,
double variance,
int seed
) {
double *entries ;
int i, inc1, inc2, j, loc, n1, n2 ;
Drand drand ;
/*
---------------
check the input
---------------
*/
if ( a == NULL
|| (n1 = a->n1) <= 0
|| (n2 = a->n2) <= 0
|| (inc1 = a->inc1) <= 0
|| (inc2 = a->inc2) <= 0
|| (entries = a->entries) == NULL ) {
fprintf(stderr, "\n fatal error in A2_fillRandomNormal(%p,%d)"
"\n bad input\n",
a, seed) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(a) || A2_IS_COMPLEX(a)) ) {
fprintf(stderr, "\n fatal error in A2_fillRandomNormal(%p,%f,%f,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
a, mean, variance, seed, a->type) ;
exit(-1) ;
}
/*
----------------
fill the entries
----------------
*/
Drand_setDefaultFields(&drand) ;
Drand_init(&drand) ;
Drand_setSeed(&drand, seed) ;
Drand_setUniform(&drand, mean, variance) ;
for ( j = 0 ; j < n2 ; j++ ) {
for ( i = 0 ; i < n1 ; i++ ) {
loc = i*inc1 + j*inc2 ;
if ( A2_IS_REAL(a) ) {
entries[loc] = Drand_value(&drand) ;
} else if ( A2_IS_COMPLEX(a) ) {
entries[2*loc] = Drand_value(&drand) ;
entries[2*loc+1] = Drand_value(&drand) ;
}
}
}
return ; }
/*
-----------------------
transpose the matrix
created -- 98may01, cca
-----------------------
*/
void
A2_transpose (
A2 *mtx
) {
int inc1, n1 ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in A2_transpose(%p)"
"\n bad input\n", mtx) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_transpose(%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, mtx->type) ;
exit(-1) ;
}
n1 = mtx->n1 ;
mtx->n1 = mtx->n2 ;
mtx->n2 = n1 ;
inc1 = mtx->inc1 ;
mtx->inc1 = mtx->inc2 ;
mtx->inc2 = inc1 ;
return ; }
/*
-----------------------------------------------
purpose -- to write the matrix in matlab format
created -- 98may01, cca
-----------------------------------------------
*/
void
A2_writeForMatlab (
A2 *mtx,
char *mtxname,
FILE *fp
) {
int irow, jcol, ncol, nrow ;
if ( mtx == NULL || mtxname == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in A2_writeForMatlab(%p,%p,%p)"
"\n bad input\n", mtx, mtxname, fp) ;
spoolesFatal();
}
nrow = A2_nrow(mtx) ;
ncol = A2_ncol(mtx) ;
for ( irow = 0 ; irow < nrow ; irow++ ) {
for ( jcol = 0 ; jcol < ncol ; jcol++ ) {
if ( A2_IS_REAL(mtx) ) {
double value ;
A2_realEntry(mtx, irow, jcol, &value) ;
fprintf(fp, "\n %s(%d,%d) = %24.16e ;",
mtxname, irow+1, jcol+1, value) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
double imag, real ;
A2_complexEntry(mtx, irow, jcol, &real, &imag) ;
fprintf(fp, "\n %s(%d,%d) = %24.16e + %24.16e*i ;",
mtxname, irow+1, jcol+1, real, imag) ;
}
}
}
return ; }
/*
--------------------------------------------------------
purpose -- to write an adjacency object to a binary file
created -- 98may01, cca
--------------------------------------------------------
*/
void
A2_writeToBinaryFile (
A2 *mtx,
FILE *fp
) {
int size ;
if ( fp == NULL ) {
return ;
}
fwrite((void *) &mtx->type, sizeof(int), 1, fp) ;
fwrite((void *) &mtx->n1, sizeof(int), 1, fp) ;
fwrite((void *) &mtx->n2, sizeof(int), 1, fp) ;
fwrite((void *) &mtx->inc1, sizeof(int), 1, fp) ;
fwrite((void *) &mtx->inc2, sizeof(int), 1, fp) ;
if ( (size = 1 + (mtx->n1-1)*mtx->inc1 + (mtx->n2-1)*mtx->inc2) > 0
&& mtx->entries != NULL ) {
if ( A2_IS_REAL(mtx) ) {
fwrite((void *) &mtx->entries, sizeof(double), size, fp) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
fwrite((void *) &mtx->entries, sizeof(double), 2*size, fp) ;
}
}
return ; }
/*
-----------------------
set mtx(irow,*) = y[*]
created -- 98may01, cca
-----------------------
*/
void
A2_setRowZV (
A2 *mtx,
ZV *rowZV,
int irow
) {
double *entries, *row ;
int inc2, j, k, n2 ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || rowZV == NULL || ZV_size(rowZV) != (n2 = mtx->n2)
|| irow < 0 || irow >= mtx->n1 ) {
fprintf(stderr, "\n fatal error in A2_setRowZV(%p,%p,%d)"
"\n bad input\n", mtx, rowZV, irow) ;
exit(-1) ;
}
if ( ! A2_IS_COMPLEX(mtx) ) {
fprintf(stderr, "\n fatal error in A2_setRowZV(%p,%p,%d)"
"\n bad type %d, must be SPOOLES_COMPLEX\n",
mtx, rowZV, irow, mtx->type) ;
exit(-1) ;
}
k = irow * mtx->inc1 ;
inc2 = mtx->inc2 ;
entries = mtx->entries ;
row = ZV_entries(rowZV) ;
for ( j = 0 ; j < n2 ; j++, k += inc2 ) {
entries[2*k] = row[2*j] ;
entries[2*k+1] = row[2*j+1] ;
}
return ; }
/*
-----------------------
set mtx(*,jcol) = y[*]
created -- 98may01, cca
-----------------------
*/
void
A2_setColumnZV (
A2 *mtx,
ZV *colZV,
int jcol
) {
double *col, *entries ;
int inc1, i, k, n1 ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || colZV == NULL || ZV_size(colZV) != (n1 = mtx->n1)
|| jcol < 0 || jcol >= mtx->n2 ) {
fprintf(stderr, "\n fatal error in A2_setColumnZV(%p,%p,%d)"
"\n bad input\n", mtx, colZV, jcol) ;
exit(-1) ;
}
if ( ! A2_IS_COMPLEX(mtx) ) {
fprintf(stderr, "\n fatal error in A2_setColumnZV(%p,%p,%d)"
"\n bad type %d, must be SPOOLES_COMPLEX\n",
mtx, colZV, jcol, mtx->type) ;
exit(-1) ;
}
k = jcol * mtx->inc2 ;
inc1 = mtx->inc1 ;
entries = mtx->entries ;
col = ZV_entries(colZV) ;
for ( i = 0 ; i < n1 ; i++, k += inc1 ) {
entries[2*k] = col[2*i] ;
entries[2*k+1] = col[2*i+1] ;
}
return ; }
/*
--------------------------------------------------------------
returns 1 if the storage is row major, otherwise returns zero.
created -- 98may01, cca
--------------------------------------------------------------
*/
int
A2_rowMajor (
A2 *mtx
) {
/*
---------------
check the input
---------------
*/
if ( mtx == NULL ) {
fprintf(stderr, "\n fatal error in A2_rowMajor(%p)"
"\n bad input\n", mtx) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_rowMajor(%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, mtx->type) ;
exit(-1) ;
}
if ( mtx->inc2 == 1 ) {
return(1) ;
} else {
return(0) ;
} }
/*
--------------------------
fill the matrix with zeros
created -- 98may01, cca
--------------------------
*/
void
A2_zero (
A2 *a
) {
double *entries ;
int i, inc1, inc2, j, loc, n1, n2 ;
/*
---------------
check the input
---------------
*/
if ( a == NULL
|| (n1 = a->n1) <= 0
|| (n2 = a->n2) <= 0
|| (inc1 = a->inc1) <= 0
|| (inc2 = a->inc2) <= 0
|| (entries = a->entries) == NULL ) {
fprintf(stderr, "\n fatal error in A2_zero(%p)"
"\n bad input\n", a) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(a) || A2_IS_COMPLEX(a)) ) {
fprintf(stderr, "\n fatal error in A2_zero(%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
a, a->type) ;
exit(-1) ;
}
for ( j = 0 ; j < n2 ; j++ ) {
for ( i = 0 ; i < n1 ; i++ ) {
loc =i*inc1 + j*inc2 ;
if ( A2_IS_REAL(a) ) {
entries[loc] = 0.0 ;
} else if ( A2_IS_COMPLEX(a) ) {
entries[2*loc] = 0.0 ;
entries[2*loc+1] = 0.0 ;
}
}
}
return ; }
/*
----------------------------
extract row[*] = mtx(irow,*)
created -- 98may01, cca
----------------------------
*/
void
A2_extractRow (
A2 *mtx,
double row[],
int irow
) {
double *entries ;
int inc2, j, k, n2 ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || row == NULL || mtx->entries == NULL
|| irow < 0 || irow >= mtx->n1 ) {
fprintf(stderr, "\n fatal error in A2_extractRow(%p,%p,%d)"
"\n bad input\n", mtx, row, irow) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_extractRow(%p,%p,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, row, irow, mtx->type) ;
exit(-1) ;
}
k = irow * mtx->inc1 ;
n2 = mtx->n2 ;
inc2 = mtx->inc2 ;
entries = mtx->entries ;
if ( A2_IS_REAL(mtx) ) {
for ( j = 0 ; j < n2 ; j++, k += inc2 ) {
row[j] = entries[k] ;
}
} else if ( A2_IS_COMPLEX(mtx) ) {
for ( j = 0 ; j < n2 ; j++, k += inc2 ) {
row[2*j] = entries[2*k] ;
row[2*j+1] = entries[2*k+1] ;
}
}
return ; }
/*
----------------------------
extract col[*] = mtx(*,jcol)
created -- 98may01, cca
----------------------------
*/
void
A2_extractColumn (
A2 *mtx,
double col[],
int jcol
) {
double *entries ;
int i, inc1, k, n1 ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || col == NULL || mtx->entries == NULL
|| jcol < 0 || jcol >= mtx->n2 ) {
fprintf(stderr, "\n fatal error in A2_extractColumn(%p,%p,%d)"
"\n bad input\n", mtx, col, jcol) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtx) || A2_IS_COMPLEX(mtx)) ) {
fprintf(stderr, "\n fatal error in A2_extractColumn(%p,%p,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
mtx, col, jcol, mtx->type) ;
exit(-1) ;
}
k = jcol * mtx->inc2 ;
n1 = mtx->n1 ;
inc1 = mtx->inc1 ;
entries = mtx->entries ;
if ( A2_IS_REAL(mtx) ) {
for ( i = 0 ; i < n1 ; i++, k += inc1 ) {
col[i] = entries[k] ;
}
} else if ( A2_IS_COMPLEX(mtx) ) {
for ( i = 0 ; i < n1 ; i++, k += inc1 ) {
col[2*i] = entries[2*k] ;
col[2*i+1] = entries[2*k+1] ;
}
}
return ; }
/*
----------------------------------------------
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 ; }
/*
----------------------------------------
fill the matrix with the identity matrix
created -- 98may01, cca
----------------------------------------
*/
void
A2_fillWithIdentity (
A2 *a
) {
double *entries ;
int ii, inc, inc1, inc2, j, n ;
/*
---------------
check the input
---------------
*/
if ( a == NULL
|| (n = a->n1) <= 0
|| n != a->n2
|| (inc1 = a->inc1) <= 0
|| (inc2 = a->inc2) <= 0
|| (inc1 != 1 && inc2 != 1)
|| (entries = a->entries) == NULL ) {
fprintf(stderr, "\n fatal error in A2_fillWithIdentity(%p)"
"\n bad input\n", a) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(a) || A2_IS_COMPLEX(a)) ) {
fprintf(stderr, "\n fatal error in A2_fillWithIdentity(%p)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
a, a->type) ;
exit(-1) ;
}
inc = (inc1 == 1) ? inc2 : inc1 ;
A2_zero(a) ;
for ( j = 0, ii = 0 ; j < n ; j++, ii += inc + 1 ) {
if ( A2_IS_REAL(a) ) {
entries[ii] = 1.0 ;
} else if ( A2_IS_COMPLEX(a) ) {
entries[2*ii] = 1.0 ;
}
}
return ; }
/*
--------------------------------------------------
copy the first column of mtxA into the vector H0[]
created -- 98may30, cca
--------------------------------------------------
*/
static int
copyIntoVec1 (
A2 *mtxA,
double H0[],
int msglvl,
FILE *msgFile
) {
double ival, rval ;
double *colA ;
int ii, inc1, irow, jj, lastrow, ncolA, nrowA ;
/*
----------------------------------
copy the column of A into a vector
and find the last nonzero element
----------------------------------
*/
nrowA = mtxA->n1 ;
ncolA = mtxA->n2 ;
inc1 = mtxA->inc1 ;
lastrow = -1 ;
colA = A2_column(mtxA, 0) ;
if ( A2_IS_REAL(mtxA) ) {
for ( irow = ii = jj = 0 ;
irow < nrowA ;
irow++, ii += inc1, jj++ ) {
rval = colA[ii] ;
if ( rval != 0.0 ) {
H0[jj] = rval ;
lastrow = irow ;
}
}
} else if ( A2_IS_COMPLEX(mtxA) ) {
for ( irow = ii = jj = 0 ;
irow < nrowA ;
irow++, ii += 2*inc1, jj += 2 ) {
rval = colA[ii] ; ival = colA[ii+1] ;
if ( rval != 0.0 || ival != 0.0 ) {
H0[jj] = rval ; H0[jj+1] = ival ;
lastrow = irow ;
}
}
}
return(lastrow) ; }
/*
-------------------------------------------------
purpose -- to write an object to a formatted file
created -- 98may01, cca
-------------------------------------------------
*/
void
A2_writeToFormattedFile (
A2 *mtx,
FILE *fp
) {
int size ;
if ( mtx == NULL || fp == NULL ) {
return ;
}
fprintf(fp, "\n %d %d %d %d %d",
mtx->type, mtx->n1, mtx->n2, mtx->inc1, mtx->inc2) ;
if ( (size = 1 + (mtx->n1-1)*mtx->inc1 + (mtx->n2-1)*mtx->inc2) > 0
&& mtx->entries != NULL ) {
if ( A2_IS_REAL(mtx) ) {
DVfprintf(fp, size, mtx->entries) ;
} else if ( A2_IS_COMPLEX(mtx) ) {
DVfprintf(fp, 2*size, mtx->entries) ;
}
}
return ; }
/*
--------------------------------------
purpose -- to write out the statistics
created -- 98may01, cca
--------------------------------------
*/
void
A2_writeStats (
A2 *mtx,
FILE *fp
) {
if ( mtx == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in A2_writeStats(%p,%p)"
"\n bad input\n", mtx, fp) ;
spoolesFatal();
}
if ( A2_IS_REAL(mtx) ) {
fprintf(fp, "\n A2 : double 2D array object :") ;
} else if ( A2_IS_COMPLEX(mtx) ) {
fprintf(fp, "\n A2 : double complex 2D array object :") ;
}
fprintf(fp,
"\n %d x %d matrix, inc1 = %d, inc2 = %d,"
"\n nowned = %d, %d entries allocated, occupies %d bytes"
"\n entries = %p, maxabs = %20.12e",
mtx->n1, mtx->n2, mtx->inc1, mtx->inc2, mtx->nowned,
mtx->n1*mtx->n2,
A2_sizeOf(mtx), mtx->entries, A2_maxabs(mtx)) ;
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 ; }
/*
-----------------------
compute W0 = v^H * A
created -- 98may30, cca
-----------------------
*/
static double
computeW1 (
A2 *mtxA,
double H0[],
double W0[],
int msglvl,
FILE *msgFile
) {
double nops ;
int inc1, inc2, ncolA, nrowA ;
if ( msglvl > 5 ) {
fprintf(msgFile, "\n %% inside computeW1, nrow %d, ncol %d",
mtxA->n1, mtxA->n2) ;
}
nrowA = mtxA->n1 ;
ncolA = mtxA->n2 ;
inc1 = mtxA->inc1 ;
inc2 = mtxA->inc2 ;
if ( inc1 != 1 && inc2 != 1 ) {
fprintf(stderr, "\n error in computeW1"
"\n inc1 = %d, inc2 = %d\n", inc1, inc2) ;
exit(-1) ;
}
nops = 0.0 ;
if ( A2_IS_REAL(mtxA) ) {
int irow, jcol ;
if ( inc1 == 1 ) {
double sums[3] ;
double *colA0, *colA1, *colA2 ;
/*
----------------------------
A is column major,
compute W(j) = H0^T * A(*,j)
----------------------------
*/
for ( jcol = 0 ; jcol < ncolA - 2 ; jcol += 3 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
colA2 = A2_column(mtxA, jcol+2) ;
DVdot13(nrowA, H0, colA0, colA1, colA2, sums) ;
W0[jcol] = sums[0] ;
W0[jcol+1] = sums[1] ;
W0[jcol+2] = sums[2] ;
nops += 6*nrowA ;
}
if ( jcol == ncolA - 2 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
DVdot12(nrowA, H0, colA0, colA1, sums) ;
W0[jcol] = sums[0] ;
W0[jcol+1] = sums[1] ;
nops += 4*nrowA ;
} else if ( jcol == ncolA - 1 ) {
colA0 = A2_column(mtxA, jcol) ;
DVdot11(nrowA, H0, colA0, sums) ;
W0[jcol] = sums[0] ;
nops += 2*nrowA ;
}
} else {
double alpha[3] ;
double *rowA0, *rowA1, *rowA2 ;
/*
-------------------------------
A is row major
compute W := W + H0(j) * A(j,*)
-------------------------------
*/
DVzero(ncolA, W0) ;
for ( irow = 0 ; irow < nrowA - 2 ; irow += 3 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
rowA2 = A2_row(mtxA, irow+2) ;
alpha[0] = H0[irow] ;
alpha[1] = H0[irow+1] ;
alpha[2] = H0[irow+2] ;
DVaxpy13(ncolA, W0, alpha, rowA0, rowA1, rowA2) ;
nops += 6*ncolA ;
}
if ( irow == nrowA - 2 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
alpha[0] = H0[irow] ;
alpha[1] = H0[irow+1] ;
DVaxpy12(ncolA, W0, alpha, rowA0, rowA1) ;
nops += 4*ncolA ;
} else if ( irow == nrowA - 1 ) {
rowA0 = A2_row(mtxA, irow) ;
alpha[0] = H0[irow] ;
DVaxpy11(ncolA, W0, alpha, rowA0) ;
nops += 2*ncolA ;
}
}
} else if ( A2_IS_COMPLEX(mtxA) ) {
int irow, jcol ;
if ( inc1 == 1 ) {
double sums[6] ;
double *colA0, *colA1, *colA2 ;
/*
----------------------------
A is column major
compute W(j) = H0^H * A(*,j)
----------------------------
*/
for ( jcol = 0 ; jcol < ncolA - 2 ; jcol += 3 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
colA2 = A2_column(mtxA, jcol+2) ;
ZVdotC13(nrowA, H0, colA0, colA1, colA2, sums) ;
W0[2*jcol] = sums[0] ; W0[2*jcol+1] = sums[1] ;
W0[2*(jcol+1)] = sums[2] ; W0[2*(jcol+1)+1] = sums[3] ;
W0[2*(jcol+2)] = sums[4] ; W0[2*(jcol+2)+1] = sums[5] ;
nops += 24*nrowA ;
}
if ( jcol == ncolA - 2 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
ZVdotC12(nrowA, H0, colA0, colA1, sums) ;
W0[2*jcol] = sums[0] ; W0[2*jcol+1] = sums[1] ;
W0[2*(jcol+1)] = sums[2] ; W0[2*(jcol+1)+1] = sums[3] ;
nops += 16*nrowA ;
} else if ( jcol == ncolA - 1 ) {
colA0 = A2_column(mtxA, jcol) ;
ZVdotC11(nrowA, H0, colA0, sums) ;
W0[2*jcol] = sums[0] ; W0[2*jcol+1] = sums[1] ;
nops += 8*nrowA ;
}
} else {
double alpha[6] ;
double *rowA0, *rowA1, *rowA2 ;
/*
---------------------------------
A is row major
compute W := W + H0(j)^H * A(j,*)
---------------------------------
*/
DVzero(2*ncolA, W0) ;
for ( irow = 0 ; irow < nrowA - 2 ; irow += 3 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
rowA2 = A2_row(mtxA, irow+2) ;
alpha[0] = H0[2*irow] ; alpha[1] = -H0[2*irow+1] ;
alpha[2] = H0[2*(irow+1)] ; alpha[3] = -H0[2*(irow+1)+1] ;
alpha[4] = H0[2*(irow+2)] ; alpha[5] = -H0[2*(irow+2)+1] ;
ZVaxpy13(ncolA, W0, alpha, rowA0, rowA1, rowA2) ;
nops += 24*ncolA ;
}
if ( irow == nrowA - 2 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
alpha[0] = H0[2*irow] ; alpha[1] = -H0[2*irow+1] ;
alpha[2] = H0[2*(irow+1)] ; alpha[3] = -H0[2*(irow+1)+1] ;
ZVaxpy12(ncolA, W0, alpha, rowA0, rowA1) ;
nops += 16*ncolA ;
} else if ( irow == nrowA - 1 ) {
rowA0 = A2_row(mtxA, irow) ;
alpha[0] = H0[2*irow] ; alpha[1] = -H0[2*irow+1] ;
ZVaxpy11(ncolA, W0, alpha, rowA0) ;
nops += 8*ncolA ;
}
}
}
return(nops) ; }
/*
---------------------------------
compute A := A - H0 * beta0 * W0
created -- 98may30, cca
---------------------------------
*/
static double
updateA1 (
A2 *mtxA,
double H0[],
double beta0,
double W0[],
int msglvl,
FILE *msgFile
) {
double nops ;
int inc1, inc2, ncolA, nrowA ;
if ( msglvl > 5 ) {
fprintf(msgFile, "\n %% inside updateA1, nrow %d, ncol %d",
mtxA->n1, mtxA->n2) ;
}
nrowA = mtxA->n1 ;
ncolA = mtxA->n2 ;
inc1 = mtxA->inc1 ;
inc2 = mtxA->inc2 ;
nops = 0.0 ;
if ( A2_IS_REAL(mtxA) ) {
int irow, jcol ;
if ( inc1 == 1 ) {
double alpha[3] ;
double *colA0, *colA1, *colA2 ;
/*
-----------------------------------------
A is column major
compute A(:,jcol) -= beta * W0(jcol) * H0
-----------------------------------------
*/
for ( jcol = 0 ; jcol < ncolA - 2 ; jcol += 3 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
colA2 = A2_column(mtxA, jcol+2) ;
alpha[0] = -beta0 * W0[jcol] ;
alpha[1] = -beta0 * W0[jcol+1] ;
alpha[2] = -beta0 * W0[jcol+2] ;
DVaxpy31(nrowA, colA0, colA1, colA2, alpha, H0) ;
nops += 6*nrowA ;
}
if ( jcol == ncolA - 2 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
alpha[0] = -beta0 * W0[jcol] ;
alpha[1] = -beta0 * W0[jcol+1] ;
DVaxpy21(nrowA, colA0, colA1, alpha, H0) ;
nops += 4*nrowA ;
} else if ( jcol == ncolA - 1 ) {
colA0 = A2_column(mtxA, jcol) ;
alpha[0] = -beta0 * W0[jcol] ;
DVaxpy11(nrowA, colA0, alpha, H0) ;
nops += 2*nrowA ;
}
} else {
double alpha[3] ;
double *rowA0, *rowA1, *rowA2 ;
/*
-----------------------------------------
A is row major
compute A(irow,:) -= H0[irow]*beta0*W0(:)
-----------------------------------------
*/
for ( irow = 0 ; irow < nrowA - 2 ; irow += 3 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
rowA2 = A2_row(mtxA, irow+2) ;
alpha[0] = -beta0 * H0[irow] ;
alpha[1] = -beta0 * H0[irow+1] ;
alpha[2] = -beta0 * H0[irow+2] ;
DVaxpy31(ncolA, rowA0, rowA1, rowA2, alpha, W0) ;
nops += 6*ncolA + 3 ;
}
if ( irow == nrowA - 2 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
alpha[0] = -beta0 * H0[irow] ;
alpha[1] = -beta0 * H0[irow+1] ;
DVaxpy21(ncolA, rowA0, rowA1, alpha, W0) ;
nops += 4*ncolA + 2 ;
} else if ( irow == nrowA - 1 ) {
rowA0 = A2_row(mtxA, irow) ;
alpha[0] = -beta0 * H0[irow] ;
DVaxpy11(ncolA, rowA0, alpha, W0) ;
nops += 2*ncolA + 1 ;
}
}
} else if ( A2_IS_COMPLEX(mtxA) ) {
int irow, jcol ;
if ( inc1 == 1 ) {
double alpha[6] ;
double *colA0, *colA1, *colA2 ;
/*
-----------------------------------------
A is column major
compute A(:,jcol) -= beta * W0(jcol) * H0
-----------------------------------------
*/
for ( jcol = 0 ; jcol < ncolA - 2 ; jcol += 3 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
colA2 = A2_column(mtxA, jcol+2) ;
alpha[0] = -beta0 * W0[2*jcol] ;
alpha[1] = -beta0 * W0[2*jcol+1] ;
alpha[2] = -beta0 * W0[2*(jcol+1)] ;
alpha[3] = -beta0 * W0[2*(jcol+1)+1] ;
alpha[4] = -beta0 * W0[2*(jcol+2)] ;
alpha[5] = -beta0 * W0[2*(jcol+2)+1] ;
ZVaxpy31(nrowA, colA0, colA1, colA2, alpha, H0) ;
nops += 24*nrowA ;
}
if ( jcol == ncolA - 2 ) {
colA0 = A2_column(mtxA, jcol) ;
colA1 = A2_column(mtxA, jcol+1) ;
alpha[0] = -beta0 * W0[2*jcol] ;
alpha[1] = -beta0 * W0[2*jcol+1] ;
alpha[2] = -beta0 * W0[2*(jcol+1)] ;
alpha[3] = -beta0 * W0[2*(jcol+1)+1] ;
ZVaxpy21(nrowA, colA0, colA1, alpha, H0) ;
nops += 16*nrowA ;
} else if ( jcol == ncolA - 1 ) {
colA0 = A2_column(mtxA, jcol) ;
alpha[0] = -beta0 * W0[2*jcol] ;
alpha[1] = -beta0 * W0[2*jcol+1] ;
ZVaxpy11(nrowA, colA0, alpha, H0) ;
nops += 8*nrowA ;
}
} else {
double alpha[6] ;
double *rowA0, *rowA1, *rowA2 ;
/*
-----------------------------------------
A is row major
compute A(irow,:) -= H0[irow]*beta0*W0(:)
-----------------------------------------
*/
for ( irow = 0 ; irow < nrowA - 2 ; irow += 3 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
rowA2 = A2_row(mtxA, irow+2) ;
alpha[0] = -beta0 * H0[2*irow] ;
alpha[1] = -beta0 * H0[2*irow+1] ;
alpha[2] = -beta0 * H0[2*(irow+1)] ;
alpha[3] = -beta0 * H0[2*(irow+1)+1] ;
alpha[4] = -beta0 * H0[2*(irow+2)] ;
alpha[5] = -beta0 * H0[2*(irow+2)+1] ;
ZVaxpy31(ncolA, rowA0, rowA1, rowA2, alpha, W0) ;
nops += 24*ncolA + 12 ;
}
if( irow == nrowA - 2 ) {
rowA0 = A2_row(mtxA, irow) ;
rowA1 = A2_row(mtxA, irow+1) ;
alpha[0] = -beta0 * H0[2*irow] ;
alpha[1] = -beta0 * H0[2*irow+1] ;
alpha[2] = -beta0 * H0[2*(irow+1)] ;
alpha[3] = -beta0 * H0[2*(irow+1)+1] ;
ZVaxpy21(ncolA, rowA0, rowA1, alpha, W0) ;
nops += 16*ncolA + 8 ;
} else if( irow == nrowA - 1 ) {
rowA0 = A2_row(mtxA, irow) ;
alpha[0] = -beta0 * H0[2*irow] ;
alpha[1] = -beta0 * H0[2*irow+1] ;
ZVaxpy11(ncolA, rowA0, alpha, W0) ;
nops += 8*ncolA + 4 ;
}
}
}
return(nops) ; }
/*
-----------------------------------------------
purpose -- to read an object from a binary file
return value -- 1 if success, 0 if failure
created -- 98may01, cca
-----------------------------------------------
*/
int
A2_readFromBinaryFile (
A2 *mtx,
FILE *fp
) {
int rc, size ;
int itemp[5] ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in A2_readFromBinaryFile(%p,%p)"
"\n bad input", mtx, fp) ;
return(0) ;
}
/*
---------------------
clear the data fields
---------------------
*/
A2_clearData(mtx) ;
/*
------------------------------------------------------------
read in the five scalar parameters: type, n1, n2, inc1, inc2
------------------------------------------------------------
*/
if ( (rc = fread((char *) itemp, sizeof(int), 5, fp)) != 5 ) {
fprintf(stderr, "\n error in A2_readFromBinaryFile"
"\n %d items of %d read\n", rc, 5) ;
return(0) ;
}
fprintf(stdout, "\n itemp = {%d, %d, %d, %d, %d}",
itemp[0], itemp[1], itemp[2], itemp[3], itemp[4]) ;
fflush(stdout) ;
/*
---------------------
initialize the object
---------------------
*/
A2_init(mtx, itemp[0], itemp[1], itemp[2], itemp[3], itemp[4], NULL) ;
/*
----------------------------
read in the entries[] vector
----------------------------
*/
if ( (size = 1 + (mtx->n1-1)*mtx->inc1 + (mtx->n2-1)*mtx->inc2) > 0 ) {
if ( A2_IS_REAL(mtx) ) {
if ( (rc = fread(mtx->entries, sizeof(double), size, fp))
!= size ) {
fprintf(stderr, "\n error in A2_readFromBinaryFile"
"\n %d items of %d read\n", rc, size) ;
return(0) ;
}
} else if ( A2_IS_COMPLEX(mtx) ) {
if ( (rc = fread(mtx->entries, sizeof(double), 2*size, fp))
!= 2*size ) {
fprintf(stderr, "\n error in A2_readFromBinaryFile"
"\n %d items of %d read\n", rc, 2*size) ;
return(0) ;
}
}
}
return(1) ; }
/*
--------------------------------------------------
purpose -- to read an object from a formatted file
return value -- 1 if success, 0 if failure
created -- 98may01, cca
--------------------------------------------------
*/
int
A2_readFromFormattedFile (
A2 *mtx,
FILE *fp
) {
int rc, size ;
int itemp[5] ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || fp == NULL ) {
fprintf(stderr, "\n error in A2_readFromFormattedFile(%p,%p)"
"\n bad input", mtx, fp) ;
return(0) ;
}
/*
---------------------
clear the data fields
---------------------
*/
A2_clearData(mtx) ;
/*
-----------------------------------------------------------
read in the five scalar parameters: type n1, n2, inc1, inc2
-----------------------------------------------------------
*/
if ( (rc = IVfscanf(fp, 5, itemp)) != 5 ) {
fprintf(stderr, "\n error in A2_readFromFormattedFile()"
"\n %d items of %d read\n", rc, 5) ;
return(0) ;
}
/*
---------------------
initialize the object
---------------------
*/
A2_init(mtx, itemp[0], itemp[1], itemp[2], itemp[3], itemp[4], NULL) ;
/*
----------------------------
read in the entries[] vector
----------------------------
*/
if ( (size = 1 + (mtx->n1-1)*mtx->inc1 + (mtx->n2-1)*mtx->inc2) > 0 ) {
if ( A2_IS_REAL(mtx) ) {
if ( (rc = DVfscanf(fp, size, mtx->entries)) != size ) {
fprintf(stderr, "\n error in A2_readFromFormattedFile"
"\n %d items of %d read\n", rc, size) ;
return(0) ;
}
} else if ( A2_IS_COMPLEX(mtx) ) {
if ( (rc = DVfscanf(fp, 2*size, mtx->entries)) != 2*size ) {
fprintf(stderr, "\n error in A2_readFromFormattedFile"
"\n %d items of %d read\n", rc, 2*size) ;
return(0) ;
}
}
}
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) ; }
/*
----------------------------------------------------
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 ; }
/*
-------------------------------------------------
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) ; }
/*
--------------------------------------------------------------
purpose -- compute A = QR, where Q is a product of householder
vectors, (I - beta_j v_j v_j^T). on return, v_j is
found in the lower triangle of A, v_j(j) = 1.0.
return value -- # of floating point operations
created -- 98may25, cca
--------------------------------------------------------------
*/
double
A2_QRreduce (
A2 *mtxA,
DV *workDV,
int msglvl,
FILE *msgFile
) {
A2 tempA ;
double nops ;
double beta0 ;
double *colA, *H0, *W0 ;
int inc1, inc2, jcol, lastrow, length, ncolA, nrowA, nstep ;
/*
---------------
check the input
---------------
*/
if ( mtxA == NULL || workDV == NULL
|| (msglvl > 0 && msgFile == NULL) ) {
fprintf(stderr, "\n fatal error in A2_QRreduce()"
"\n bad input\n") ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(mtxA) || A2_IS_COMPLEX(mtxA)) ) {
fprintf(stderr, "\n fatal error in A2_QRreduce()"
"\n matrix must be real or complex\n") ;
exit(-1) ;
}
nrowA = A2_nrow(mtxA) ;
ncolA = A2_ncol(mtxA) ;
inc1 = A2_inc1(mtxA) ;
inc2 = A2_inc2(mtxA) ;
if ( A2_IS_REAL(mtxA) ) {
DV_setSize(workDV, nrowA + ncolA) ;
H0 = DV_entries(workDV) ;
W0 = H0 + nrowA ;
} else if ( A2_IS_COMPLEX(mtxA) ) {
DV_setSize(workDV, 2*(nrowA + ncolA)) ;
H0 = DV_entries(workDV) ;
W0 = H0 + 2*nrowA ;
}
/*
-------------------------------------------------
determine the number of steps = min(ncolA, nrowA)
-------------------------------------------------
*/
nstep = (ncolA <= nrowA) ? ncolA : nrowA ;
/*
-------------------
loop over the steps
-------------------
*/
nops = 0.0 ;
for ( jcol = 0 ; jcol < nstep ; jcol++ ) {
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% jcol = %d", jcol) ;
}
/*
----------------------------------
copy the column of A into a vector
and find the last nonzero element
----------------------------------
*/
A2_subA2(&tempA, mtxA, jcol, nrowA-1, jcol, ncolA-1) ;
length = 1 + copyIntoVec1(&tempA, H0, msglvl, msgFile) ;
lastrow = jcol + length - 1 ;
if ( msglvl > 5 ) {
fprintf(msgFile,
"\n %% return from copyIntoVec1, length = %d, lastrow = %d",
length, lastrow) ;
}
/*
------------------------------
compute the Householder vector
and place into the column of A
------------------------------
*/
colA = A2_column(mtxA, jcol) ;
if ( A2_IS_REAL(mtxA) ) {
nops += getHouseholderVector1(SPOOLES_REAL, length, H0,
&beta0, msglvl, msgFile) ;
A2_subA2(&tempA, mtxA, jcol, lastrow, jcol, jcol) ;
A2_setColumn(&tempA, H0, 0) ;
H0[0] = 1.0 ;
} else if ( A2_IS_COMPLEX(mtxA) ) {
nops += getHouseholderVector1(SPOOLES_COMPLEX, length, H0,
&beta0, msglvl, msgFile) ;
A2_subA2(&tempA, mtxA, jcol, lastrow, jcol, jcol) ;
A2_setColumn(&tempA, H0, 0) ;
H0[0] = 1.0 ; H0[1] = 0.0 ;
}
if ( msglvl > 5 && jcol == 0 ) {
fprintf(msgFile, "\n %% beta0 = %12.4e;", beta0) ;
}
if ( beta0 != 0.0 && jcol + 1 < ncolA ) {
A2_subA2(&tempA, mtxA, jcol, lastrow, jcol+1, ncolA-1) ;
/*
------------------------------------------------
compute w = v^T * A(jcol:lastrow,jcol+1:nrowA-1)
------------------------------------------------
*/
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% compute w") ;
}
nops += computeW1(&tempA, H0, W0, msglvl, msgFile) ;
/*
-------------------------------------------------
update A(jcol:lastrow,jcol+1:nrowA-1) -= beta*v*w
-------------------------------------------------
*/
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% update A") ;
}
nops += updateA1(&tempA, H0, beta0, W0, msglvl, msgFile) ;
}
}
return(nops) ; }
/*
----------------------------
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 ; }
/*
---------------------------
swap two rows of the matrix
created -- 98may01, cca
---------------------------
*/
void
A2_swapRows (
A2 *a,
int irow1,
int irow2
) {
double temp ;
double *row1, *row2 ;
int inc2, j, k, n2 ;
/*
-----------
check input
-----------
*/
if ( a == NULL
|| irow1 < 0 || irow1 >= a->n1
|| irow2 < 0 || irow2 >= a->n1 ) {
fprintf(stderr,
"\n fatal error in A2_swapRows(%p,%d,%d)"
"\n bad input\n", a, irow1, irow2) ;
exit(-1) ;
}
if ( a->n1 <= 0
|| a->inc1 <= 0
|| (n2 = a->n2) <= 0
|| (inc2 = a->inc2) <= 0
|| a->entries == NULL ) {
fprintf(stderr,
"\n fatal error in A2_swapRows(%p,%d,%d)"
"\n bad structure\n", a, irow1, irow2) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(a) || A2_IS_COMPLEX(a)) ) {
fprintf(stderr, "\n fatal error in A2_swapRows(%p,%d,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
a, irow1, irow2, a->type) ;
exit(-1) ;
}
if ( irow1 == irow2 ) {
return ;
}
if ( A2_IS_REAL(a) ) {
row1 = a->entries + irow1*a->inc1 ;
row2 = a->entries + irow2*a->inc1 ;
if ( inc2 == 1 ) {
for ( j = 0 ; j < n2 ; j++ ) {
temp = row1[j] ;
row1[j] = row2[j] ;
row2[j] = temp ;
}
} else {
for ( j = 0, k = 0 ; j < n2 ; j++, k += inc2 ) {
temp = row1[k] ;
row1[k] = row2[k] ;
row2[k] = temp ;
}
}
} else if ( A2_IS_COMPLEX(a) ) {
row1 = a->entries + 2*irow1*a->inc1 ;
row2 = a->entries + 2*irow2*a->inc1 ;
if ( inc2 == 1 ) {
for ( j = 0 ; j < n2 ; j++ ) {
temp = row1[2*j] ;
row1[2*j] = row2[2*j] ;
row2[2*j] = temp ;
temp = row1[2*j+1] ;
row1[2*j+1] = row2[2*j+1] ;
row2[2*j+1] = temp ;
}
} else {
for ( j = 0, k = 0 ; j < n2 ; j++, k += inc2 ) {
temp = row1[2*k] ;
row1[2*k] = row2[2*k] ;
row2[2*k] = temp ;
temp = row1[2*k+1] ;
row1[2*k+1] = row2[2*k+1] ;
row2[2*k+1] = temp ;
}
}
}
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) ; }
/*
------------------------------
swap two columns of the matrix
created -- 98may01, cca
------------------------------
*/
void
A2_swapColumns (
A2 *a,
int jcol1,
int jcol2
) {
double temp ;
double *col1, *col2 ;
int i, inc1, k, n1 ;
/*
-----------
check input
-----------
*/
if ( a == NULL
|| jcol1 < 0 || jcol1 >= a->n2
|| jcol2 < 0 || jcol2 >= a->n2 ) {
fprintf(stderr,
"\n fatal error in A2_swapColumns(%p,%d,%d)"
"\n bad input\n", a, jcol1, jcol2) ;
exit(-1) ;
}
if ( (n1 = a->n1) <= 0
|| (inc1 = a->inc1) <= 0
|| a->n2 <= 0
|| a->inc2 <= 0
|| a->entries == NULL ) {
fprintf(stderr,
"\n fatal error in A2_swapColumns(%p,%d,%d)"
"\n bad structure\n", a, jcol1, jcol2) ;
exit(-1) ;
}
if ( ! (A2_IS_REAL(a) || A2_IS_COMPLEX(a)) ) {
fprintf(stderr, "\n fatal error in A2_swapColumns(%p,%d,%d)"
"\n bad type %d, must be SPOOLES_REAL or SPOOLES_COMPLEX\n",
a, jcol1, jcol2, a->type) ;
exit(-1) ;
}
if ( jcol1 == jcol2 ) {
return ;
}
if ( A2_IS_REAL(a) ) {
col1 = a->entries + jcol1*a->inc2 ;
col2 = a->entries + jcol2*a->inc2 ;
if ( inc1 == 1 ) {
for ( i = 0 ; i < n1 ; i++ ) {
temp = col1[i] ;
col1[i] = col2[i] ;
col2[i] = temp ;
}
} else {
for ( i = 0, k = 0 ; i < n1 ; i++, k += inc1 ) {
temp = col1[k] ;
col1[k] = col2[k] ;
col2[k] = temp ;
}
}
} else if ( A2_IS_COMPLEX(a) ) {
col1 = a->entries + 2*jcol1*a->inc2 ;
col2 = a->entries + 2*jcol2*a->inc2 ;
if ( inc1 == 1 ) {
for ( i = 0 ; i < n1 ; i++ ) {
temp = col1[2*i] ;
col1[2*i] = col2[2*i] ;
col2[2*i] = temp ;
temp = col1[2*i+1] ;
col1[2*i+1] = col2[2*i+1] ;
col2[2*i+1] = temp ;
}
} else {
for ( i = 0, k = 0 ; i < n1 ; i++, k += inc1 ) {
temp = col1[2*k] ;
col1[2*k] = col2[2*k] ;
col2[2*k] = temp ;
temp = col1[2*k+1] ;
col1[2*k+1] = col2[2*k+1] ;
col2[2*k+1] = temp ;
}
}
}
return ; }